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16-Sep- 1982 98: 19: i SORTS2.SRC SORSCR 10.8 33:1 : (1) 
1 001 MODULE SORSSCR_I0 ( 
¢ 008 ow = 'v04-000' ! File: SORSCRIO.B32 Edit: PDG3053 
¢ Boe eee 
§ 38 | eeneneneneueceneceensenenennanecevereseerererereeuenanenesncnsnscenanereeere 
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8 8 ‘® COPYRIGHT (c) 1978, 1980, 1982, 1984 BY * 
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? Bary i. ALL RIGHTS RESERVED * 
! ® 
¢ org 1® rus SOF TWARE 4 FURNISHED UNDER A LICENSE AND MAY BE USED AND core * 
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4 014 :® INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTH * 
5 0015 :* COPIES THEREOF oy NOT BE PROVIDED OR OTHERWISE MADE AVA LAE TO ANY * 
6 8018 !# OTHER PERSON, NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
{ id EA 7 TRANSFERRED. e 
'® * 
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! 
FACILITY: VAX=11 SORT/MERGE 
ABSTRACT: 
This module contains RMS 1/0 support for work/scratch files. 
ENVIRONMENT: VAX/VMS user mode 
AUTHOR: Peter D Gilbert, CREATION DATE: 10-May-1982 
MODIFIED BY: 
i 103- 15 ginal 
45 : T dt ix problens wits computing COM_BUF SIZE (due to b08 ast set). 
4 ! status after calling COM_INPOT. PDG 13-De 
4 ! 103-017 ‘mak opening scratch files now recoverable. $56. lecpec~ -1982 
48 ! 103-018 Make write errors to a work file fatal. PDG 22-Dec-1982 
49 ! 103-019 Make the size of the buffer passed to the weer-uritten input 
31 foutine, fe for 1325e"* equal to the LRL (rather than larger). 
¢ ! T03-020 Changed te | use Q10Ws for work erie /O. 
5 ' Adde protection XAB, PDG 28-Dec-198 
3 T03-021 pee yorne! description co (WFBs) distinct from DDBs. 
§ ! 103- 0e¢ Added clean-up routines. POG 4-Jan-1983 
! T Added a FNS parameter to WORK_OPEN. PDG 6-Jan-1983 


SSCR_10 -Sep-1984 00:40:3 AX-11 Bliss-32 V4.0-74 Page 2 

vou~ 860" 1g Sen-1 984 99:18:28 SORT32.SRCJSORSCRIO.B32;1 (1) 

; 8 8 1} 103-068 Remove declaration of unreferenced externals. PDG 26-Jan-1983 ; 
; i i } 703-025 wese wre aes! by bo t COM_MRG_STREAM to the file or stream ; 
; : number. ; 
; 2 oe ! 703-026 pee OA PERS agrather than COM_MRG_ORDER) to indicate a merge. : 
; : an=1 ; 
: e§ 068 1: 103-027 Changes for hostile environment. PDG 3-Feb-1983 : 
; 064 1: T03-0¢8 Pass the context eddress to got ipeck rout ines. 0g, 11-Feb-1983 ; 
; 65 065 1! T0Q3- Make SORS_NO_WRK fatal in WORK OPEN. PDG 9-Mar-19 ; 
> 66 8008 1} 703-050 Maximize DEQ with TUN_K BUFSIZE. PDG 31-Mar-198 : 
; «67 067 1: ¥ -031 Information hiding of WFB structure. PDG 12-Apr-1983 : 
; 668 0068 1 : T03- § Remove declaration of WFB_DEV. PDG 13-Apr-19 : 
; 9 09? 1! 103-033 Make DELRUN and POSITION fon-global routines. Call FLUSH with : 
H 0 070 1! COM_RUN_CURR in SORSSWORK_MERGE. Remove DS? parameter from : 
jaa 071 1! WORR_MERGE routines. PDG 14-Apr-1985 : 
<2 0072 1! 103-034 Move definitions of fields anne itic to scratch-i/o from SORLIB : 
De. 0075 1! into this module. PDG 18-Apr- : 
; «74 0074 1! T03-035 Massive changes; better use of scratch file space, by allow . 
; ££ 0075 1! runs to be composed 9 Little pieces ‘ei ee PDG 2 aprei983" : 
; 0076 1! 103-036 Page align the work f jhe buffers. PDG 27-Apr-1983 : 
Be as 0077 1! T03-037 Check for more than 127 pages in WORK_WRITE. PDG 28-Apr-1983 : 
:; £78 0078 1! ut et Add stuff for operator assistance (in comments). 99-Apr-1983 : 
0079 1! 103-039 Free RDBs Linked te _ geLOcks in CLEAN . ; 
; 80 0080 1! Free file name strin rror in WORK op PEN. PDG 2-May-1983 : 
; «68 0081 1! 703-040 Change BLOCKS . cae arg sie WFB_ FULL tS BBLOCK. PDG 9-May-1983 : 
; «8 0082 1: T03-041 Chan °. sever nd of LIBSFREE_EF errors. PDG se -1983 : 
; 8 0085 1! Don’ ieces vg senlry otten from GET ; 
3 Be boge : T03-042 A apoty Je Jack* 4 ey to identical pieces of code in” POSITION and : 
: 86 0086 1! 103-043 Use the "GRECKPOINT facility. PDG 19-Sep-1983 ; 
: 0087 1! 103-044 SORSSBEST_FILE NAME assumes NAMSB_RSL and NAMSB_ESL are zero : 
; 8 0088 1! before the OPEN or CREATE. PDG gy POG? : 
; «89 0089 1! 3-93? condts jonas ize chockpe int tng pceee PDG 17-Jan-1984 : 
; 090 1! 103-046 46 Make CFT_CON_ADR relative. §-Jan-198 ; 
ma 091 1: 6 Correct the calculation Finaing the eddress for work file names : 
3 ¢ 0092 1! otten from C con_get ADR. PDG 1-Feb-1984 : 
ee. 0093 1! 103-047 Correct version iden : 
; | (96 0094 1! 703-048 Add support for VAXELit Jeff East 1/2/84 : 
; 695 0095 1! 103-049 Add recovery from RMS$_RLK errect. PDG “a 3 
; 096 1! T03-050 eee improvements in MRG_WORK_READ. Clear VFC area for merges. ; 
3 a sad : poergve er ore r C reporting when «ao scratch files can be found. : 
3 D4 4 i 703-051 Fie aj ninor cor robles in MRG_WORK_READ for hostile environment. : 
: 101 tor 1 103-052 Add. UF g ERRORS to avoid. infinite Loop when we run out of 
; 10 1 ; 1} work file space. : 
; 105 1! 703-053 change Com HB to COM_RHB_INP and COM_RHB_OUT. 3 
: 104 + 1! his is to avoid problems with merge, where an incoming 5 
; 105 105 1! veal overwrites the VFC area for the outgoing record. : 
: 136 198 ! PDG 24-Jul-1984 : 
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LIBRARY * SYSSLIBRARY: STARLET*; 
LIBRARY ‘SYSSLIBRARY:XPORT'; 
REQUIRE ‘SRC$:COM'; 


ccc 
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FORWARD ROUTINE 

SORSSWORK_MERGE : 
SORSSWORK—~NEWRUN: 
SORSSWORK WRITE: 


SORSSTHECKPO] 
PSH CHECKPOINT, 


SORSSWORK D: 
ZIF FUN_K CHECKPOINT %TH 


CAL_CTXREG NOVALUE, 
JSB"NEWRUN NOVALUE, 
JSB-0U 


JS3~ Ms 
EN ~ 
CAL_CTXREG NOVALUE, 


RIF ADECLARED(ZQUOTE SDESCRIPTOR) ZTHEN UNDECLARE XQUOTE SDESCRIPTOR; %F1 


Determine which runs to merge 


' Start a new LONG run 


Write to a work file 
Read from a work file 


Take a checkpoint 
Post-checkpoint handler 


2F I 

SORSSWRK_ALQ: CAL_CTXREG, ! Calculate work file allocation 
GET BUFFER: CAL_CTXREG NOVALUE, ! Get a buffer 
FREE BUFFER: CAL_CTXREG NOVALUE, ' Put a buffer on the free List 
POSITION: CAL_CTXREG NOVALUE, ! Position to start of a run 
MRG_WORK_MERGE: CAL_CTXREG NOVALUE, ' Set up for merge 
MRG_WOR : JSB_INPUT ! Read from a file for merge 
WORR OP CAL-CTXREG NOVALUE, | Open a work file 
FLUSA: CAL_CTXREG NOVALUE, ' Flush a buffer 

T_RDB CAL_CTXREG NOVALUE, ! Get a hole 
FREE _RDB CAL-CTXREG NOVALUE, ' Free a hole 

WRON: CAL_CTXREG NOVALUE, ' Start a new run 
DELRUN: CAL_CTXREG, ! Indicate run no longer needed 
CLEAN_UP: CAL_CTXREG NOVALUE; ! Release resources 


SORSSEND_ROUTINE_(CLEAN_UP) ; ! Declare a clean-up routine 
ZIF HOSTILE ZTHEN 
MACR 
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4 
5 
6 
v 0908 
U 9 0 
U 0 LIBSGET VM = SORSLIBSGET_VM %, 
U 1 SYS$QI0Q = SORS$SYS 
U : SYSSCREATE = SORSSYSSCREATE %, 
U Z SYSSDASSGN = SORSSYSSDASSGN 2%; 
5 
§ EXTERNAL ROUTINE 
SORSSBEST_FILE_NAME:CAL_CTXREG NOVALUE, 
g SORSSFREE-FILE-NAME:CAL~CTXREG NOVALUE, 
SORSSALLOCATE: CAL_CTXREG, ' Allocate storage 
0 SORSSDEALLOCATE: CAL_CTXREG NOVALUE, ! Deallocate storage 
1 ZIF NOT HOSTILE THEN 
§ LIBSGET_EF: ADDRESSING_MODE (GENERAL), ' Get an event flag 
Z JESFREE_EF : ADDRESSING_MODE (GENERAL), ! Free event flag 
5 IBSGET_VM: ADDRESSING_MODE (GENERAL), 
U § IF FUN_K_CHECKPOINT ZTHEN 
U CHKSCHKPNT: ADDRESSING_MODE (GENERAL) WEAK, 
U 3 CHKSDCLPSH: ADDRESSING_MODE (GENERAL) WEAK 
U CHKSDCLRSH: ADDRESSING _MODE (GENERAL) WEAK, 
U 0 CHKSCANPSH: ADDRESSING _MODE (GENERAL) WEAK, 
U 1 yl ateaaaa ADDRESSING_MODE (GENERAL) WEAK, 
: SORSSERROR; ! Issue diagnostics 
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; 1 4 1 

; 169 U 5 1 XIF_FUN_K CHECKPOINT XTHEN 

; 168 U § 1 EXTERNAL CITERAL 

> 169 U 1 CHKS_NOTINIT WEAK; 

; 170 3 1 2FI 

s Wy 1 

3 176 40 1 LITERAL 

; Vt? 8 ¢ ! FUN_K_ASSIST = FALSE AND NOT HOSTILE; 

s 7 0 rk 1! This Literal determines how frequently checkpoints are done. 

: 176 0244 1 ! A count-down counter, COM_COUNTDOWN is decremented by one for: 

3: 177 8 45 1! each record released te / read by the sort /neree. 

; #178 46 1! each record returned from / written by the sort/merge, and 
3; «179 0247 1! each block written to / read from a scratch file. 

; 130 8 re | ! When the counter goes negative, a checkpoint is taken. 

3 ise 8 50 1 LITERAL 

; 51 1 TUN_K_ONE MINUTE = 60000, ! About one minute???, standalone 780 
; 184 0 3g TUN-K-COUNTDOWN = TUN_K.ONE_MINUTE * 10; ! Every ten minutes 
; | «(186 0954 1 MACRO 

: 187 0255 1 FREE_RDB_(X, FLD) = FREE_RDB(X, ZFIELDEXPAND(FLD,0)) 2%, 

> 188 0256 1 MOVE-ALL-RDBS_(Q, FLD) ="WHILE .Q NEQ 0 DO FREE_RDB_(Q, FLD) %; 


— ss tt 


SCoooocooooo wOooonoovono 
SOoooooooooooooooooooo 


09.09 090909090909 SININI INI NIN NINA AAA AAAAAOOUIUI 
NOUS WN 0 OONOUSWN (OO CONOULS UT" OVOO 


cr 
OOoooooooo 


Rorororofofrorony 


1 2 2 = ts 2 2 2s 1 SS 1 ss 1 


Ot et et at a 
OOONOUSWN—O 


Rorenoronorfrony 


CONTEXT AREA 


i 

' 

! The following fields in the context area are referenced only by this 

} module. 

SFIELD 

oF IELBS = 

SOVERLAY (COM_SCRATCH_ 10) 
$_0= $BYTES(0)J, 
S_BUF _FREE= XADDR]J, ! Pointer to free List of buffers 
$_BUF _SIZE= XLONG), ! Size in ose of a buffer 
S_RUN_CURR= ADDRJ, ! Address of current run block 
S_RUN_INFO= XADDRJ, ! Address of list of run descriptions 
S_WRK_DEQ= XLONGJ, ' Default extend amount for work files 
S_WRK_EFN= XLONGJ, ! Event flag to use for work files 
S_WRK_WFB= XADDRIJ, ! Address of work file WFBs 
S_BUF __ALLOC= XADDR], ! Pointer to List of allocated buffers 
S_PSH_HANDLER= [(XLONGJ, ' Handler-id for post-checkpoint handler 
S_RSH_HANDLER= [(XLONG ! Handler-id for restart handler 
S“1= YTES(O)] 
TES; 

LITERAL TMP_K_SCRATCH = %FIELDEXPAND(S 1,0)-%F IELDEXPAND(S_0,0); 

ASSERT _(TMP_K SCRATCH LEQ COM_K_SCRATCA) 

ZIF TMP_K SCRATCH LSS COM_K_SCRATCH 

ZTHEN XMESSAGE('COM_K_SCRATCH can be reduced from ', %NUMBER(COM_K_SCRATCH), 
"to ', XNUMBER(TMP_K_SCRATCH)) %FI 

STRUCTURE 


BBLOCKCO,P,S,E;8S=0) = CBS] (BBLOCK+0)<P,S,E>; 
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1 ~3007 1382 99:90:25 eORTS2° $Re SORSCRI B4351 
WORK FILE DESCRIPTION BLOCK 

The WFB contains information for reading/writing a work file. 


The media storage for each WFB is qeversbes by non-overlapping RDBs, 
with each media block represented in exactly one RDB. To Simpl tty 
processing, a distinguished end-of-file RDB represents a near-infinite 
amount of media blocks that would be available if the work file were 
extended. The RDBs that are not currently holding part of a run are 
Linked into one of three Lists in the WFB. 


WFB_FULL contains RDBs thas are the least desirable for holding runs. 
Usually, only the end-of-file RDB is on this List; this causes other 
RDBs to be reused rather than increasing the work file allocation. 


WFB_FREE and WFB_NOUSE contain RDBs that are available to hold runs. 
The distinction Ts important when atid is done. Because the 
information in the work files is not checkpointed, the checkpointed 
data structures in —— must represent a valid interpretation of the 
data stored in the work files, so that a restart from the previous 
checkpoint will still result in a correct sort. We may overwrite data 
in media blocks only if the checkpointed data structures indicate that 
there is no useful data in those blocks. 


WFB_NOUSE contains RDBs that have been checkpointed as containing no 
useful data. WFB_FREE contains the other RDBs that contain no useful 
data. Thus, RDBs should be allocated from WFB_NOUSE and released to 
WFB_FREE. Just after a checkpoint is taken, the RDBs are moved from 
WFB_FREE to WFB_NOUSE. 
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WEB_FIELDS = 
WFB_NEXT= CXADDRI, ! Pointer to next WFB 
WFB_NAME= $SUB_BLOCK(2)], ! File name length/address 
WFB"ALQ= XLONGJ, ' Allocation 

FB_FREE= XADDRI, ! Free RDBs for this work file 
WFB_NOUSE= XADDRIJ, ' Free RDBs for this work file 
WFB_FULL= XADDR), ! Unusable RDBs for this WB 
WFB_ERRORS= XWORDJ, ! Error count 
WFB_CHAN= XWORD ! Channel number 
WFB_DEV= XLONG ' Device characteristics 
8 Nadal SBYTESC1+NAM$S_DVI1)] ! ASCIC Device name 
WFB_K_SIZE= SFIELD_SET_UNITS; ! Size in bytes 
WFB_BLOCK= ZEXPAND SUNIT_BLOCK(WFB_K_SIZE) FIELD(WFB_FIELDS) 2%; 


RMESSAGE('WFB_K_SIZE = *, ZNUMBER(WFB_K_SIZE), ° bytes") 
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3 are 1! RUN BLOC , 
> 274 35 1; : 
3 ero 40 1! : 
s af 41 1! A run is a sequence of records that are known to be in order. : 
; e7 t§ 14 The merge pass merges these runs. The information necessary to ; 
. af 45 1! position to the start of each run is stored in the following data : 
; 0 te ! structure. : 
; «281 8 rf 1! Run blocks on the S_RUN_INFO List: : 
: : 8 rh i identify the location and Length of a run of records. : 
3 4 8 ri 1! On output: : 
3 5 50 1! RUN_ - VBN of the next block to write. ; 
; 286 0351 1! RUN_SIZE_ = number of blocks written to the run so far. : 
; «287 0326 1! UN_BUFFO = number of free bytes in the buffer. . 
; 4 S327 : RUN_BUFF1 = address of the first free byte in the buffer. : 
; 296 0355 1! On input: : 
; 291 O28 1! RUN_VBN- = VBN of the next block to read. : 
3 4 0357 1! RUN_SIZE_ = number of blocks in this run. : 
; 2 0358 1! RUN_BUFFO = bytes in the buffer that haven't been read yet. ; 
; Be 8328 : RUN_BUFF1 = address of first byte that hasn't been read yet. : 
; 296 0361 1 SUNIT_FIELD : 
; 297 b308 1 RUN_FIELDS= ; 
; 298 03635 1 SET : 
; oy 0364 1 RUN_NEXT= XADDRI, : Pointer to next run block : 
; 300 0365 1 RUN_DDB= XADDRJ, ! Addr of DDB for merge stream : 
; 301 0366 1 _VBN= XLONG], ! VBN of first block in run ; 
; 308 0367 1 ~SIZE= XLONGJ, ! Blocks in this run : 
; 0368 1 RUN_RDB_CURR= XADDRI, ' Current RDB : 
3; 304 0369 1 RUN_BUF FER= XADDRI, ! Pointer to buffer 3 
; 305 0370 1 RUN_BUF FO= XLONGJ, ! Remaining Length in buffer : 
; 306 0371 1 RUN_ BUFF 1= XADDRI, ! Address of remainder of buffer 3 
3 4 6358 1 RUN_COUNT= XLONG], ' Records in this run : 
; 308 03735 1 RUN_RDB= CXADDRJ ! List of RDBs in this run : 
3; SOP 0374 1 ES; : 
; 310 0375 1 LITERAL : : 
s 311 0376 1 RUN_K_SIZE= SFIELD_SET_UNITS; ! Length in bytes : 
: \¢ 0377 1 MACRO 3 
3 i oare ! RUN_BLOCK= ZEXPAND SUNIT_BLOCK(RUN_K_SIZE) FIELD(RUN_FIELDS) 2%; : 
; «#315 L 0380 1 XMESSAGE(*RUN_K_SIZE = *, XNUMBER(RUN_K_SIZE), * bytes") : 
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: 317 , of RUN DESCRIPTION BLOCK 

i at 

; ) 41 This block describes a chunk of mass storage that can be used to hold 
: 1 5 ! } some blocks of a run. 

; : a SUNIT_FIELD 

; 4 : 1 ROB_FIELDS= 

: 5 1 SET 

: 6 90 1 RDB_NEXT= XADDRI, ! Pointer to next RDB block 
; 7 91 #1 RDB_WFB= XADORJ, ! Pointer to WEB for RDB 

: 8 36 1 RDB_VBN= XLONGJ, ' VBN of first block in RDB 
; 9 93 1 RDB_SIZE= XLONG ! Blocks in this RDB 

H 0394 1 ES; 

; 1 0395 1 LITERAL 

: § 8 38 1 neces RDB_K_SIZE= SFIELD_SET_UNITS; ! Length in bytes 

: 3 $444 \ RDB_BLOCK= ZEXPAND SUNIT_BLOCK(RDB_K_SIZE) FIELD(RDB_FIELDS) 2%; 
: 336 L 0400 1 ZMESSAGE('RDB_K_SIZE = ', %NUMBER(RDB_K_SIZE), ' bytes") 
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3 8 401 1 SUNIT_FIELD : 
3 9 ¢ 1 BUF _FIELDS= : 
; 340 4 1 SET $ 
> 341 0404 1 BUF _NEXT= bras P ' Ptr to next free buffer : 
; ri} Be 5 } BUF ~ADDR= XADDR ' Address of this block : 
3 te Be ? : MACRO BUF _BLOCK= ZEXPAND SUNIT_BLOCK(O) FIELD(BUF_FIELDS) %; ; 
; ré] ek 84 : ; Macroes to insert/remove items into/from a list, at the head/tail ; 
: 348 M0411 1 MACRO  INSLH_(LIST,ITEM,NEXT) = ! Insert at head of List : 
3; 349 M Beis 1 BEGIN § 
; 350 M0415 1 ITEMCNEXT) = .LIST; . 
; 351 M0414 1 LIST = ITEMCBASE_J; : 
3 326 0415 1 END %; 5 
: 2 M0416 1 MACRO INSLT (LIST, ITEM,NEXT) = ! Insert at tail of List ; 
: 3554 M0417 1 BEGIN 3 
3 $22 M0418 1 LOCAL 3 
3 396 M0419 1 PPTR: REF VECTOR(C1); 3 
: Sar M0420 1 PPTR = LIST = KCO,NEXTI; : 
s 358 M0421 1 WHILE .BBLOCKCPPTRCO meat, NEQ 0 DO b 
; 359 ¥ O4g¢ 1 PTR = ,BBLOCKCPPTRLOJ,NEXT); ; 
; 360 «i 0493 BBLOCKLPPTRLOI NEXT = ITEMCBASE_J; : 
3 $08 M bese 1 MACRO  REMLH (LIST, 1 TEM,NEXT,ALQ) = ! Remove from head of List 

; 36 M0426 1 N 

s 306 M pest 1 %IF XNULL(ALQ) 

: 365 M0428 1 XTHEN 

; 366 M oh 34 1 IF (ITEM = .LIST) NEQ 0 

s 367 M0430 1 THEN (LIST = .ITEMCNEXT]; ITEMCNEXTJ = 0; TRUE) 

; 368 M0431 1 ELSE (FALSE) 

: 369 M bes 1 ELSE 

: 370 M 043 1 SORSSDEALLOCATE(ALQ, LIST, .ITEMCNEXT)); 

: 3571 M0434 1 FI 

,. Be 0435 1 END %; 
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1$-e0-1964 00:40:52 YAKa11 Blisg=32 V4.0-743 | 
ROUTINE ree 


RUNBLOCK: REF RUN BLOCK 


! Addr of run description block 
): CAL_CTXREG NOVACUE = 


++ 
: FUNCTIONAL DESCRIPTION: 
This routine gets a buffer for the run. 
It first attempts to get a buffer from the free List of buffers. 
If this fails, it allocates more memory for the buffer. 
FORMAL PARAMETERS: 
CTX Longword pointing to work area (passed in COM_REG_CTX) 
IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 
ROUTINE VALUE: 
NONE 
! SIDE EFFECTS: 
NONE 


' 
q 
' 
' 
' 
' 
i 
1 
lee 
BEGIN 
EXTERNAL REGISTER 
CTX =  COM_REG_CTX: 
LOCAL 
RUN: REF RUN_BLOCK; 


REF CTX_BLOCK_(S_FIELDS); 
! Addr of run description block 


See whether we already have a buffer 


RUN = RUNBLOCK(BASE_) 
1F RUN RUN_BUFFERJ~EQL 0 


BEGIN 
LOCAL 

BUFPTR: REF BUF _BLOCK; 
! Remove the buffer from the beginning of the List. 


! If nothing in the List, create a new buffer. 
i Store the address of the buffer 


' 
iF NOT REMLH_(CTXCS_BUF_FREEJ, BUFPTR, BUF_NEXT) 
BEGIN 


i We want the storage to be aligned on a page boundary. 


! Pointer to buffer 


D 15 
are R_10 19 Sep- :40:3 AX-11 Bliss-32 V4.0-74 Page 11 
Be-000" 12780871382 99:40:25 — -EaOar dz Re Ssonstrig.o$3.1 9° 68) 

: 431 493 4 ! Get an extra page, uarantee sufficient page-aligned pages. . 
3; 4 § 494 4 ! Instead of deal oéat ing the unused porti lons. eh hey ore used to : 
, 6 495 4 i maintain a Linked List of the allocated blocks, using fields : 
> 434 $38 4 ! BUF_NEXT and BUF_ADDR. The field BUF_NEXT is also used in the ; 
; : 5 rt ? } page-aligned portion when it is put on the free List. “ 
3 4 5 499 4 LOCAL ; 
; 438 500 4 DEL, : 
: 439 501 4 P: REF BUF _BLOCK, : 
: 440 8206 4 STATUS; ; 
3 441 503 4 STATUS = LIBSGET_VM(XZREF (.CTXCS_BUF_SIZE]+COM_K_BPERPAGE) ,BUFPTR) ; ; 
; 44 bene 4 IF NOT .STATUS : 
3; 44 505 4 THEN . 
3 tae bee 2 RETURN SORSSERROR(SORS_SHR_SYSERROR, 0, .STATUS); ; 
; Prk b205 : Determine how much free space is at the beginning. : 
3 448 0510 4 DEL = (=.BUFPTR AND (COM_K_BPERPAGE~-1)); ; 
3; 449 0511 4 : 
: 450 b31¢ 4 ! Put the memory on the S_BUF_ALLOC List : 
3; 451 051 4 i , 
3 ri 0514 4 P = BUFPTRCBASE_] ; 
3s 45 0515 4 IF .DEL LSS 2*Z0PV PVAL ! Enough room for BUF_NEXT and BUF _ADDR? : 
3 454 0516 4 —_, ; 
; 455 0517 4 PCBASE_]) + crxts. BUF _SIZE] + 2*ZUPVAL; . 
: 456 0518 4 PLBUF _ADDR} = BUFPTRCBASE_); ; 
: ri 14 $313 rf INSLH_ (CTXES_ BUF _ALLOC], P, BUF_NEXT); : 
; 459 §a54 4 ! Adjust BUFPTR to be page aligned . 
: 460 b25§ 4 ! ; 
; 461 05 4 BUFPTR = .BUFPTR + .DEL; ‘ 
: re 0524 END; ; 
; 46 0525 . 
3 464 0526 RUNCRUN_BUFFER] = BUFPTRCBASE_); . 
; 465 0527 § END; : 
: 466 0528 ; 
3; 467 B26) 2 RUNCRUN BUFFS] 5 “txts BUF _S 
; 468 0530 2 RUNCRUN_BUFF1) = .RUNCRON “BOF 
3; 469 0531 2 
: 470 0532 1 END; 

TITLE sonsscn 10 

. IDENT 4-000\ 

-PSECT SORSRO_CODE 2,NOWRT, SHR, PIC, 


00000000V 00000 _CLEAN_UP: 
-LONG <CLEAN_UP=_CLEAN_UP> : 


.EXTRN SORSSBEST FILE -NAME 

“EXTRN SORSSFREE-F AME 

"EXTRN SORSSALT CATES ~SOR SDEALLOCATE 
“EXTRN LIBSGET_EF, LIBSFREE EF 

*EXTRN tIBSCET” “VM; SORSSERROR 


-PSECT SORSRO_CODE,NOWRT, SHR, PIC,2 


; Routine Size: 


CB 


00 
12 


00 


OCrunm OWMouw 
MOoooo wowvo 


AE 


Routine Base: 


04 
14 


oocc 
04 
04 


ge 
00000200 
04 
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00D0 
14 
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RPS OOM D SIMO AOOM MOM OPM LS MOO LM 


Sss 

oo 
ons 

Coro wos 


FOQoQoQooooM OO 2M FW £9 OW TS BM FOWONMMOory 
o 
o 
co 


OOooooooooooooooooooooooo°ooo 


OVVIIOIF990 ON -VGIMNon"IOVITIM"OOO-TC 90-90 “970M 


o 
o 
co 
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SORSRO_CODE + 0000 


ck 


use 
td 


-Sep-1984 


-Sep-1984 


2$: 


Ww 
wn 


SUBL 
r 


4 818585 


000C 00000 CET BUFFER: 


SORT 


Save R2,R3 

RUNBLOCK, RUN 
(RUN) 

O4(CTX), BUFPTR 

@BUFPTR, 204(CTX) 

@BUFPTR 


BUF PTR 
12, 208(CTX), 4(SP) 
4esps 

He, inthe 85 vM 


#1839540 
‘3. SORSSERROR 


BUFPTR, RO 
#0 etn o RO, DEL 


ar Bliss-32 V4.0 
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900.0007 1 =300-1382 90:48:28 enats2e SRE SoastRin.o39:1 . (9) 
: 47 3} ROUTINE FREE_BUFFER 
: 474 5 1 RUNBLOCK: REF RUN_BLOCK ! Addr of run description block 
3; 475 8 1 ): CAL_CTXREG NOVACUE = 
ig |i 
; 47 33 | FUNCTIONAL DESCRIPTION: 
: 480 541 1 This routine puts a buffer on the free List. 
3 rt b2e§ : It also frees the unused portion of RDB connected to the RUN block. 
: 48s ts | FORMAL PARAMETERS : 
: 485 346 1 i RUNBLOCK Address of run description block 
: $38 Beet : CTX Longword pointing to work area (passed in COM_REG_CTX) 
: 48 0549 { IMPLICIT INPUTS: 
Pi ae tia 
: 49 0388 | IMPLICIT OUTPUTS: 
: a -_ 
: 496 oae9 1 ROUTINE VALUE: 
3; 497 0558 1! 
elt hi 
: 500 0561 1 | SIDE EFFECTS: 
; 501 b26¢ 1! 
3 206 0565 1! NONE 
: 30a ose 2 BEGIN 
: 505 0566 EXTERNAL REGISTER 
; 206 0967 cocat =  COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 
: 508 0569 BUFPTR: REF BUF _BLOCK, 
; 298 Beo9 RUN: REF RUN_BLOCK; 
; 211 0378 RUN = RUNBLOCK(BASE_J; 
: 12 057 BUFPTR = ;RUNCRUN.BOFFERI; 
ee 0574 RUNCRUN_BUFFER) = 0; ' Not necessary, but by doing this ... 
; 314 0575 RUN ae aa tl = 8: ! ... an error elsewhere ... | : 
3 316 278 RUNCRUN_BUFF1) = 0; ! ... should cause an access violation 
; a4 278 } Insert the buffer on the List (at the head) 
: 325 380 INSLH_(CTXCS_BUF_FREEJ, BUFPTR, BUF_NEXT); 
; 1 5 ! Update th "s current RDB. 
3 388 : Put the unused space at the end of the RDB on the WFB_NOUSE List. 
: 524 585 BEGIN 
: 5 : LOCAL 
: $ 5 RDB ROB miCRUH Rio CORRIC: 
; 3 8 335 IF rpBtBase ) Rea 0 THEN 
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; Routine Size: 


53 


# 
4 
98 4 
94 4 
595 4 
596 4 
597 4 
98 4 
599 4 
600 4 
601 4 
60¢ 
60 
604 
0605 
0606 1 
08 a0 


97 bytes, 


Be 19:10:35 


15 
1he4 Sep 
14- ~Sep-1 
IF RUNCRUN. VBNJ - .RDBCRDB_VBN] LSSU .RDBCRDB_SIZEJ 
BEGIN 
LOCAL 
NEW REF RDB_BLOCK: 
NEW = SORSSALLOCATE (RDB- K SIZE); 
NEWCRDB_WFBJ = .RDBCROB_OFB 
NEW pbg-$1763 = RDB RDB-SIZE); 
NEWCRDB-VBN). = .RDBCLRDB-VBNI; 
RDB RDB- on 31zE} = [RUNCRUN-VBNJ. = .ROBCRDB_V 
176) = +NEW RD B-Sizé] - “ROB 
NEw RDB VBN) = .RDB BN RDB 
FREE. RDB. (ZREF (NEW BASE ey wFB *WOUSE) : 
END; 
END; 
000C 00000 FREE_BUFFER: 
SE 04 C2 0000 
50 04 AC DO 0000 
51 14 AO D0 0009 
14 Ad 7C 0000D 
1¢ AO D4 0001 
61 00c¢ cB DO 0001 
oocc CB 1 D0 0001 
52 10 AO D 9001p 
3D 13 00021 
08 Ad 08 Ag C 00 3 
OC A2 53 Di 00029 
31 1& 00020 
10 DD 0002F 
000000006 00 01 FB 00031 
0c oc A 00 00038 
04 AO 06 =A 0030 
oC A 53 D0 00042 
oc A 0c ag C2 00046 
A2 OC A2 C1 0004 
35 BB Bn 
04 AE 50 D 
04 AE OF 0 058 
0000v CF 02 FB 00058 
04 00060 1$: 


Routine Base: 


SORSRO_CODE + O08E 


UN) 
teTK) 
PTR 
R 


~s € 
2 


AX=11 Bliss-32 
SORT32.SRCJSOR str 


Save Re. R3 


RUNBLOCK, RUN 
OERUN 


BUF PTR 


(BUFPTR) 


504 (CTX) 
, RDB 


8(RUN), R3 

DB) 

sem.) ocare 
12 (NEW) 


“4 

RDB) 
» 12¢NEW) 
; 8(RDB), 


4(SP) 
REE_RDB 


8 (NEW) 


0-74 
5°33 31 
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: 547 U 9607 1 SIF ZSWITCHES(DEBUG) XTHEN 

; 54 U 06 § 1 GLOBAL ROUTINE DUMP_RDBS(PARAM): CAL_CTXREG = 

; 54 U 0609 1 BEGIN 

: 550 U 619 1 EXTERNAL REGISTER 

; 1 U 0611 1 CTX = COM PTG_CTX: REF CTX_BLOCK_(S_FIELDS); 

3 $ U oie 1 EXTERNAL ROUTINE 

3 i : ez ! SORSSOUTPUT; 

; 555 U 0613 1 DESC_(A) = UPLIT(XCHARCOUNT(A), UPLIT BYTE(A)) %; 

; 26 U 616 1 LOCAL 

; 55 U 0617 1 : REF RDB_BLOCK; 

; 28 y 0618 1 P = PARAM: 

: 22 u 0615 WHILE 2P NEG 0 00 

: 561 U 0621 1 SORSSOUTPUT (DESC_(XSTRING( 

; 266 U 06 ; 1 "txt: NEXT! EXE WFB!_!XL VBN!_!XL = SIZE!_!XL")), 
; 56 U 0623 1 ASE_} 

: 564 U 0624 1 PCRDB-NEXT), 

; 565 U 0625 1 P RDB_WFB). 

: 566 U 0626 1 PCROB-VBN 

; 567 U 0627 1 P RDB-SIZEq): 

3 208 ¥ 8° : : +. -PCRDB_NEXT); 

: 570 U 0630 1 RETURN 6; 

: 3h) y oese 4 

3 578 ¥ 0638 : GLOBAL ROUTINE DUMP_RUNS: CAL_CTXREG = 

; 375 U 0635 1 EXTERNAL REGISTER 

: 576 U 0656 1 TX =  COM-REG_CTX: REF CTX_BLOCK_(S_FIELDS); 

: 577 U 06; 1 EXTERNAL ROUTINE 

; 278 u 0658 SORSSOUTPUT; 

: 586 u 0640 i A = UPLIT(ZCHARCOUNT(A), UPLIT BYTE(A)) 2; 

; 382 U 0642 1 Q: REF WFB_BLOCK, 

: 58 U 0643 1 P: REF RUN-BLOCK: 

; 3 U 0644 1 SORSSOUTPUT (DESC (“DUMP _RUNS*)); 

; 585 U 0645 1 P = .CTXCS_RUN_IRFOJ; 

: $87 u 0646 WHILE .P NEQ 07DO 

: 588 U 0648 1 SORSSOUTPUT (DESC_(3STRING( 

: 589 U 0649 1 "IML: NEXT!" !XL DB!_'XL  VBN!_'XL  SIZE!_!xXL!7/", 
: 30 U 630 1 "i, BUFFER! TXL BUFFO!_TXL BUFFI! _TXL COUNT! _TXLI/", 
i 3 Y oee2 "BERG RENTD. PERU DOB IC SERON. BNI, .PCRUN. SIZE] 
; 38 U $38 1 ‘ UN" BUF FER) PERON. BUF FOR, .PCRUN_6UFF1J, 7PLRUN. COUNT), 
: 594 U 0654 1 :P RUN_RDB CURRI): 

: 595 u 0655 1 DUMP _RDBS (<P RON_RDBIS; 

: 96 U 36 1 P = [PCRUN_NEXTJ: 

: 9 U 0657 1 END; 

: 598 U 38 1 SORSSOUTPUT(DESC_("DUMP_WFBS")); 

: 599 u 0659 1 Q = .CTXCS wWRK_WFB); 

3 U 0660 1 WHILE .Q NEQ 0700 

: $02 1 ree i Bee SOUTPUT (DESC (ZSTRING( 

; $08 U $64 1 "IXL:  ALQ'“'XL) FREE! 'XL) © FULL!_!XL. = CHAN!_! XW", 
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H 9 244 } ROUTINE WRG WORK MERGE 3 
3 6 § 4 1 CNT ! Number of runs to find : 
3 § 6 1 LISf: REF VECTOR ! Counted List of runs to merge 3 
> 624 6 1 ): CAL_CTXREG NOVALUE = : 
; 625 684 1 !44 $ 
; © § 685 1! 3 
; e ‘ § : FUNCTIONAL DESCRIPTION: ; 
: ? ; +4 3 : This routine sets up the run information for a merge process. 3 
; 631 229 1 ! It creates run description blocks for the runs, and allocates buffer 3 
3 ? ¢ 24 : space for each run. 3 
; 634 $e98 1 ! FORMAL PARAMETERS: ; 
; 635 0694 1! 3 
3 O38 0695 1! CNT Number of runs to find 3 
; 637 3028 7 3 LIST Counted List of runs to merge (output parameter) : 
: oes 9244 ! } CTX Longword pointing to work area (passed in COM_REG_CTX) : 
3 rr +344 : The output run is automatically handled by the SORSSWORK_xxx routines. : 
; «64 0701 1 =! IMPLICIT INPUTS: 

; 64 145 1! 

> 644 0703 1! NONE 

> 645 0704 1! 

: 646 0705 1 ! IMPLICIT OUTPUTS: 

> 647 0706 1! 

; 648 0707 1! NONE 

3; 649 0708 1! 

; 650 0709 1 ! ROUTINE VALUE: 

; 651 0710 1! 

3 626 0711 1! Status code. 

; 65 orig 1! 

3; 654 0715 1 ! SIDE EFFECTS: 

: 655 0714 1! 

3; 656 ort? 1! NONE 

: 657 re 1 !e= 

; 658 071 BEGIN 

3; 659 gris EXTERNAL REGISTER 

; 660 719 CTX =  COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 

: 661 0720 LOCAL 

; 666 0721 LST: REF VECTOR 

: 66 07 é DDB: REF DDB_BLOCK, 

3 ree) Z RUN: REF RUN_BLOCK; ! Ptr to run block 

3 606 5 } Zero the count of runs to merge, and the output run. 

; 668 7 $ LST = LISTCO); 

: 9 7 3 

; 670 7 

; 671 730 ! Calculate the buffer size that will be needed. ar 

; 67 731 ! If the record interface is being used on input, this size must include 

; of? 4 § } both the actual record, and the internal format record. 

; or3 734 CTXCS_BUF $}ze) = “ST XtCOR LAL INT; 

3; 676 735 DDB =".CTRCCOM_INP_DDBJ; 
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SORSSCR_10 “Se 4 00:40:3 AX-11 Bliss-32 V4.0-74 Page 18 
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H $77 He od DDBCBASE_J EQL 0 

: 67 7 CTXCS_BUF_SIZE] = .CTXCS BUF_SIZE] + .CTXCCOM_LRLI; 

3 oay 735 CTXCS_BUF— eres = ROUND_(.CT inh BUF _S1ZE), COM_K_BPERPAGE); 

: 6 74) 

; ¢ é Ore Set up the run description blocks 

$684 ok ‘ z . : 

; 685 744 tsttoy = .CNT; 

; 6 745 INCR I FROM 1°TO .LSTCLO] bo 

; oF oe BEGIN 

: pat Ors i Allocate another run description block, and Link to the List 

: 691 0750 RUN = SORSSALLOCATE (RUN K_ SIZE); ! Allocate a new run block 

3 o 48 INSLH_ (CTXCS_RUN_INFOJ, RON, RUN_NEXT); ! Link this run block into List 
5 694 bF2g Make the run description block reference the DDB 

3; 695 0754 i (or the stream number for user-written input routines) 

: 696 0755 i Put a pointer to the run description block inte the List 

3; 697 0756 i mlereye a buffer for the internal-format records 

; $28 154 (only .CTXCCOM_LRL_INT] bytes needed for the buffer) 

: 700 0759 if .CTXCCOM_INP_DDB) EQL 0 

3; 701 0760 oes” 

; 70 0761 4 ped 

; 70 3504 4 RUNCRUN_DDB] = .1; ! Input stream number 

3; 704 0763 4 

3; 705 0764 3 

; 706 0765 4 sth 

; 707 0766 4 RUN RUN DDB) = DDBL ASE » T ' Reference the DDB 

: 708 0767 4 -BDBCDDB_NEXTI; ' Advance to next DDB 

: 709 0768 

; 710 0769 LSTC.1 het ' Put into the List 

> 711 0770 GET Saf eat BASE i, | ket & kether ter Sble Pan 
3 ay; 0771 ; IF BDBCBASE_J EQL 0 

: 71 4k: THEN 

3; «6714 0773 4 BEGIN 

3 7s 0774 4 

; 716 0775 4 RUN_BUFFER is the address of the internal format record 

3 at p77e : RUN_BUFFO/1 is the descriptor for the actual record 

: 719 0778 4 i Note that RUN _BUFFO is set to the specified LRL value, rather 
: 720 1464 4 ' than the actual amount of space available. This means that the 
: 721 re0 4 ! buffer passed to the user-written input routine is exactly the 
. Ff § 0781 4 ! size specified by the LRL. Also, this does not affect 

; i ree ? i deallocating the buffer. 

: 725 784 4 UNCRUN_BUFFO) = oe rat con LRLJ 

: f 6 785 4 UNERUN “BUFF1) = .RUNCRUN ~BUFFAD + .CTXCCOM_LRL_INT); 

: f 8 , END; 

: 4 g ; The output should be counted as another run. 

: 732 are CTXCCOM_RUNS) = .CTXCCOM_RUNS) + 1; ! One more run batted in 
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; 734 0793 1 END; 

8 

51 
60 
51 60 
60 51 
65 
000000006 00 
52 
62 
00D8 CB 
04 A2 
04 A2 

54 
6543 

FEA6 CF 

18 =A 
56 
1c a 

B5 5 
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SORSRO_CODE 


AX-11 Blis 


ORSSALLOCATE 


UN 
TX), (RUN) 
4 6 CTX) 


$s 
R 
C 


~~ a 


4 (RUN) 
DDB, 4(RUN) 
(DDB), DDB 
RUN, (LST)CI) 
GET_BUFFER 
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! If we were invoked for a merge process, call a different routine 
to set up the run information. 


if .CTXCCOM_MERGE) 
THEN 


+4445 


BEGIN 
BUILTIN 
AP 
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SORSSCR_10 16-Sep-1984 00:40:3 AX-11 Bliss-32 V4.0-74 S 
y0e 2000 12-8671 382 90:18:25 ebaTs2r $Re SORSCRIO. 03551 V 
; q o73e } GLOBAL ROUTINE SORSSWORK _MERGE ! Determine runs to merge : 
2 3 738 1 CNT ! Number of runs to find ; 
ee 797 «4 LISf: REF VECTOR ! Counted List of runs to merge ; 
; 740 798 «#1 ): CAL_CTXREG NOVALUE = : 
; 741 14 1 !+¢ : 
s 74 800 1! : 
; 74 801 1 ! FUNCTIONAL DESCRIPTION: $ 
3; 744 8 1! ; 
; 745 1! This routine decides which runs to merge. . 
; 746 0804 1! 3 
; 767 B38? 1 ! FORMAL PARAMETERS: : 
>; 748 Hy 1} 3 
3 749 0807 1! CNT Number of runs to find 3 
; 750 0808 1! LIST Counted List of runs to merge (output parameter) 3 
: ie} +t : CTX Longword pointing to work area (passed in COM_REG_CTX) : 
; 138 a8i1 \ The output run is automatically handled by the SORSSWORK_xxx routines. : 
3; 9 O81 1 ! IMPLICIT INPUTS: 3 
; 756 0814 1! 3 
3 Yor 0815 1! NONE 3 
; 758 0816 1! 3 
; To 0817 1 =! IMPLICIT OUTPUTS: : 
; 760 0818 1! : 
; 761 0819 1! NONE ; 
: 166 0820 1! 3 
3; 0821 1 ! ROUTINE VALUE: : 
: 764 88 § 1! 3 
: 765 8 1! Status code. : 
; 766 0824 1! : 
3; 767 0825 1 ! SIDE EFFECTS: 3 
; 768 68 § 73 : 
s ey 0 1! NONE F 
; 70 0828 1 !-« $ 
» wey ths BEGIN 3 
3 77 830 EXTERNAL REGISTER é 
s 77 ete CTX = COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); ; 
3; 774 th LOCAL 3 
s 775 0 LST: REF VECTOR : 
3 ore ste ate REF RUN_BLOCK; ! Ptr to run block : 
3; 778 ty SIZE_(A) = (BIND X = _.LSTCA]: RUN_BLOCK; .XCRUN_SIZE]) %, 3 
> 779 8s SWAP_(X,¥) = (LOCAL Z; 2=.X; X=.YF Y=.Z) &; 3 
; 83 : 
: 4 : 
; 4 : 
: 4 : 
2 4 3 
3 G : 
: 4 : 
: 4 : 


ANN 
LSSS 
Sooooo 


CALLG; 
CALLG(.AP, MRG_WORK_MERGE); 
RETURN; 


uw 
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; 793 1 END; 

BO 

: 79 4 ! If there is anything left to be written in the last run, 

3 ede 0856 write it out, tnd ee the buffer. 

: 799 85 RUN = .CTXCS_RUN CURRI; 

; 00 0858 FLUSH (RUNCBASE 23 

; 801 59 FREE_BUFFER(RUNLBASE_)); 

Be is 

: Bee Ose Zero the count of runs to merge, and the output run. 

; 8 0864 LST = LISTCO); 

$ 309 0865 LSTCOJ = 0; 

; 808 Baee 

; 809 086 

; 810 0868 ! Start looking at active runs. 

; 811 0869 ! 

3 aig 0870 RUN = .CTXCS_RUN_INFO]; 

3 $81 0871 

> 814 Oars 

; 815 0873 2 ! Put the first active runs into the List of runs to be merged, 

3 $18 Bare while maintaining LSTC1] as the the Largest run in the List. 

; 818 0876 DECR I FROM .CNT=-1 TO 0 DO 

3; 819 0877 BEGIN 

; 820 0878 IF RUNCBASE_J Fol 0 THEN EXITLOOP; 

; 821 0879 3 LSTCO) = ste J +1; 

; 8¢ 0880 3 LSTE.LSTCOJ] = RUNLBASE 1; 

; 8 0881 3 IF .RUNCRUN.SIZE] GTR SIZE_(1) THEN SWAP_(LSTC.LSTCOJJ, LSTC1)): 
; 824 0882 3 RUN = .RUNCRUN_NEXTI; 

; 825 088 END; 

; 826 0884 

3; 827 0885 

; 828 0886 2 ' Look through the rest of the active runs, trying to find shorter runs. 
; $6? rt 2 Since LSTC1] is the largest run in the List, we compare with it first. 
; 53 0889 2 WHILE RUNCBASE_] NEQ 0 00 ! While more active runs 
3 S36 0890 BEGIN 

: 83 0891 4 IF .RUNCRUN_SIZE) LEQ SIZE_(1) 

3 te B26 3 THEN 

> 835 0893 4 BEGIN ; 

3 836 oe ? LST 1] = RUNCBASE_); ! Replace largest with this one 
; 838 44 4 ! Put the next Largest run into LSTC1) 

: 839 97 4 ! 

: 0 0898 4 DECR I FROM .CNT TO 2 DO 

; «841 444 4 . IF SIZE_(.1) GTR SIZE_(1) THEN SWAP_(LSTC.1], LSTC1)); 

; rk 0901 RUN = .RUNCRUN_NEXT); 

3 4 it END; 

3 5 90 

: § 904 

3 rt 4 4 Position to each of the runs, and start reading them. 

; Boo 309 DECR I FROM .LSTCOJ TO 1 DO POSITION(.LSTC.1)); 
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16-Sep-1984 2 Ms $0: rf: AX-11 Bliss-32 V 
14-Sep-1984 SORT32.SRC SORSTR 
Pe sateanigaricnc CAL_CTXREG NOVALUE = 
EXTERNAL REGISTER 
LOCA CTX = COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 


L 
RUN: REF RUN_BLOCK, 


RDB: “BLOCK! 
RUN = -£TX S_RUN noB8 
RDB : ake NBS CURR); 


WFB = .RDB 
SORSSeRROR ORS SHR WRITEERR, 1 WEBCWFB_NAMEJ, .STATUS) 

IF .WEBCWFB_FULC) EGL O THEN WFBCWFB ERRORS] = .WFBLWFB_ ERRORS] + 1: 
New a SORSSALLOCATE (RDB Ke SI7E); 


.RDBCRD 
NEW RDB S176) = :RDBCRDB- sat 
= .ROB 


EWLRDB_VBN)_ = “RDB RDB 


VBNI; 
NEWT RDB S12 = NEU nD B-SIZE] - - Foe SIZE); 
RD RDBERD BVBN RDBCRDB SIZE): 
INSLH_ (OPBLWFB. FULL], NEQ, ROB_N 


! The first time we get errors on ot file, it may be due to 
a failure to — the work 


rr] 
4 
@ 
=z 
4 
@ 
4 
“ 
_— 
~ 
m 
i 
2 


i 
i The second time may be due to a teu bad RDBs, but hopefully the 
! end-of-file RDB qs vokay (the user may have EXQUOTA privilege). 
The third time, it's clear that the end-of-file RDB is also bad. 
| If the file is that bad, throw the RDBs away. 
IF .WFBCWFB_ERRORS) GEQ 3 

REMLH_(WFBCWFB_FULLJ, NEW, ROB_NEXT, RDB_K_SIZE); 


END; 


001C 00000 FULL_RDB: 


.WORD Save R2,R3,R4 
54 00D4 CB 3 000 MOVL e1ecctns, RU 
3 10 AG 999 MOVL 6(RUN), RD 
5 04 A2 0008 OVL 4 (RDB), WFB 
"a BD O00F PUSHL STATUS 
4 A’ 9F 0001 PUSHAB 4(WFB) 
1 DD 0001 PUSHL #1 
001C¢10D2 BF ODD 01 PUSHL #1839314 
000000006 00 4 FB 0001D CALLS #4, SORSSERROR 
18 A3 D5 00024 TSTL 4 (WEB) 
03 1 00 7 BNEQ $ 
1c «=6A3 OBS 9 INCW  28(WFB) 
10 0D C 1$ PUSHL #16 
000000006 09 01 FB 3 CALLS #1 SORSSA LOCATE 
OC A 0c A2 D MOVL  12(RDB), 12(NEW) 
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1e-Sep-1986 3:10:46 — ESGatS2°sReSsonseRio. 039; 1 
ROUTINE FILE_EXTEND 


WFB: REF WFB_BLOCK, ! Work file to extend 
Exs ! Extension quantity 
): CAL_CTXREG NOVALUE = 
BEGIN 
EXTERNAL REGISTER 
ete = COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 
FIB: OL ORE v8 -EXTDATA, BYTEI, ' File ident block 
FIBD: VECTO ' File ident block descriptor 
10SB: VECTOR ! Virtual addresses 
STATUS; 
' Set up me {ike identification block and its descriptor. Then issue 
+ Pa se e ich do the extend and write attributes to update the end of 
1 
CHSFILL (0, FIBSK_EXTDATA, FIBCBASE 
FIBtr BSL EXCTL) = = FIBSM_EXTEND OR riaim. AL CONB OR FIBSM_ALDEF; 
FIBCFIBSL_EXSZ MAXU(.EXSZ, .CTXCS_WRK_DEQ)); 
Fier = FIBSK_EXTDATA; 
FIBDL1J = FIB; 
US = $Q]0W( 
EFN= ake WRK es 
CHAN= .WFBCWFB_CAAN) 
FUNC= I0$_MODIFY, 
Pl= F165, 
10SB= JOSB 
ZIF HOSTILE_ELAN XTHEN 


. ELAN = .CTXCCOM_CTXADR] Z%FI ); 
IF .STATUS THEN STATUS = .10SBC0] 


IF NOT .STATUS 

BEGIN 

Complain and put remainder of the current RDB on FULL List 
FULL_RDB(. STATUS); 

END 


ELSE 
BEGIN 


Update the current allocation for this file 


vreture- ERRORS) = 
WFBCWFB-ALQ) = FIBEFIBSL _EXSZ] + .FIBCFIBSL_EXVBN); 


= IANA AAI HAA AAAI GPP NYPYDPYIPININININIPYPIPINIPIPIPINOPOPIPIPINOPOPOPINPUNPNYPY SS 
wn“ 
“4 
Pad 
“ 


END; 
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erSep-19be 19:10:49 ESGard2csnesonsee 


14-Sep-1 
ROUTINE FLUSH ' Flush the buffer for a run 


rama REF RUN BLOCK 


o CAL_CTXREG NOVACUE = 


FUNCTIONAL DESCRIPTION: 


This routine flushes a buffer. 
Important note: This routine does not update RUN_BUFF1 or RUN_bUFFO. 


FORMAL PARAMETERS: 


RUNBLOCK Address of the run description block. 
CT Longword pointing to work area (passed in COM_REG_CTX) 


IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 
ROUTINE VALUE: 

NONE 
SIDE EFFECTS: 
NONE 


BEGIN 
exten REGISTER 
Pr i. COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 


RUN: REF RUN_BLOCK; 
LOCAL 
P: VECTORC2); 
RUN = RUNBLOCKCBASE_); 
Store the number of bytes to write, and the address of the storage 


pt] = ROUND_(.RUNCRUN_BUFF1J-.RUNCRUN_BUFFER], COM_K_BPERPAGE) ; 
PCi . RUNCRUN_BUFFERT; 


Write out the buffer. 
WHILE .PLO) GTR O DO 
BEGIN 


LOCAL 
RDB: REF RDB Sette 
WFB: REF WFB- BL K, 


SIZE; !' Number of blocks to write 
! Compute the number of block we will write 


10.033; Page $8 


16 
soRsscn 10 1b-e0-198 0:40:32 YAN TL BLieg=52 V4.0-763 Page 29 


0 

1 RDB = -RUNERUN. RDB CURR); 

é WEB = .RDBCRDB_WFBI; 

SIZE = MINU 
024 .PCO) * =LN2_(COM_K_BPERPAGE) 
025 ;R08 RDB_VBNJ + .RDBCROB_SIZEJ - .RUNCRUN_VBNI, 
9 6 = 127); 
028 «SIZE EQL 0 ! Was this RDB full? 
029 THE 
8 : at GET_RDB() ! Get another RDB to use 
08 .RUNCRUN_VBN] + .SIZE GTRU .WFBCWFB_ALQ] 
034 BEGIN 
03 : 
oe } Extend the file 
03 FILE_EXTEND (WFBCBASE_ 
03 TRUNCRUN_VBN] + SIZE = .WEBCWFB_ALQ)); 
04 END 
04 ELSE 
04 BEGIN 
LOCA 


a 
10SB:  VECTORC4,WORDI, 
STATUS; 


Actually write some stuff 


Pp STATUS = $Q10W( 

Pp EFN= “CTXES WRK_EFNI, 

Pp CHAN= .WFBCWFB_CAAN], 

Pp FUNC= I10$_WRITEVBLK, 

P 10S8= os6, 

Pp ASTADR= 0, 

P ASTPRM= 

p Pi= ° C1), 

Pp P2= -SIZE * LN2_(COM_K_BPERPAGE), 
Pp = BRI 


P "RU 
IF HOSTILE_ELAN 2THEN , ELAN = .CTXCCOM_CTXADR) 2FI ); 
IF .STATUS THEN STATUS = .10SBLO); 


=OOONOUSWN “OO VONOUES WN" OVOONOu 
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MIND | MQOOOTOOCOOCOCO OOOO VOOO0 OOO WDWDWDODODODMmMo NINN 
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Pe eeu ear arene a eae eal eae oP oP oe oP ot ot ot ot ot ot ot ot ot ot ot ot ot ot ot ot et el”, | et et et et et et ed ne oe no nh nh nh nh ah oh an ania 


Be Be Se Be Se Se Ge Se Se Ge Se Se Ge Se Fs Se Se Se Ge Fe Ge Se Ge Ge Ge Ge Ge Ge Ge Ge Se Se Ge Se Se Se Ge Se Sse Se Se Se Se Se Se Se Se Se Se Sse ee Se Sess esetsas 


008 IF NOT .STATUS 

06 

bee BEGIN 

$] ; Complain and put remainder of the current RDB on FULL List 
068 FULL_RDB(. STATUS); 

069 END 

070 ELSE 

a BEGIN 

o7¢ i Update the next virtual block number to write. 
074 ! Update the number of blocks in this run. 

075 ! Update blocks read/written since Last checkpoint. 
076 ! Update the size/address of the buffer to write. 
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Start a new run 
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GLOBAL ROUTINE SORSSWORK_NEWRUN 
: JSB_NEWRUN NOVALUE = 
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| FUNCTIONAL DESCRIPTION: 
This routine starts a new run. 
FORMAL PARAMETERS: 
CTX Longword pointing to work area (passed in COM_REG_CTX) 
IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 
ROUTINE VALUE: 
NONE 
SIDE EFFECTS: 
NONE 
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BEGIN 
EXTERNAL REGISTER 
erat = COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 


RUN: REF RUN_BLOCK, 
STATUS; 


See whether there is a current run being processed. 
RUN = .CTXCS_RUN_CURR); 
I EQL 
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F RUN 0 ' Any current run? 
THEN 
6 BEGIN 
9 ; No runs yet. Open scratch files. 
0 IF .CTXCCOM_WRK_FILES) EQL 0 
0. THEN 
0 BEGIN 
SORSSERROR(SORS_NO_WRK); ! We can recover 
CTXCCOM_WRK_FILES) = DEF _WORK_FILES; i Use some work files 
WORK_OPEN(); ! Open the work files 
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v04-0007 14-Sep-19 SORT32.SRCJSOR SCR 0.8 
U IF CHKSDCLPSH NEQ 0 AND NOT .CTXCCOM_NOCHKPNT) 
J THEN GIN 
‘ STATUS = CHKSDCLPSH(PSH_ CHECKPOINT, CTXCBASE_J, CTXCS_PSH_HANDLERJ); 
U STATUS = CHKSDCLRSH(PSH_CHECKPOINT, CTXCBASE_J, CTXCS_RSH_HANDLER]); 
U IF NOT .STATUS 
U THEN 
U BEGIN 
u SORSSERROR (SORS. SHR_SYSERROR AND NOT STSSM_SEVERITY OR STSSK_ERROR, 
U CTXCCOM.NOCHKPNT) = TRUE; 
U END; 
U END; 
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FLUSH(RUNCBASE_} 
ENDS NBUFFER(RUNCBASE oa) 


so we can start the new run on a block boundary. 
Start a new run 
NEWRUN(); 


From now on, use SOR$S$WORK_WRITE to output records 
CTXECOM. OUTPUT] = SORSSWORK_WRITE; 
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There is an outstanding run. Flush it to the output file, 
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ROUTINE GET_RDB: CAL CTXREG NOVALUE = 
EXTERNAL REGISTER 


LOCAL 
RUN: 


AGAIN; 
Find a hole that we can use. 
WHILE TRUE DO 
AGAIN: BEGIN 
LOC 
REF WFB_BLOC 
LOCAL 
ANY_FREE: INITIAL(O); 
CRO 


TRY_AGAIN = LEAVE AGAIN 4; 


PREV = 0; 
WFB = CTXCS_WRK_WFB) - BBLOCK 
sine = - WFBCWFB_NEXTJ) 


CAL 
CURR_PREV: x VECTORC1); 


Bliss-32 V4.0-. 
SORT32.SRCJSORSCRIO.B_2;1 


COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 


! Ptr to previous 


AL 
eyneee SBE -ppmemedll ! Smallest signed longword 


' For all work files 


OR .WRBCWFB_FREE); 
! For RDBs in WFB_NOUSE 


BE 
IF .MAX_SIZE LSS .ROBCRDB_SIZEJ 
THEN 


E = .RDBCRDB_SIZE]; 


N 
MAX SIZ 
PREY = CURR_PREVLOJ; 


CURR. PREV = RDBCRDB_NEXT); 
END; 


END; 


Did we find something? 


F .MAX_ SIZE GTR 0 THEN EXITLOOP; 


i 
IF FUN_K_CHECKPOINT 
XTHEN 


3 
3 
; 
: Find the largest hole. 
4 
4 
4 
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6 
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! Exit if no extend needed 
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Feet oC IRGC MOLINE AND .ANY_FREE NEQ 0 


BEGIN 
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i Request a check oink. This will cause the RDBs to move 
from the WFB_FREE List to the WFB_NOUSE List. 


SORSS$CHECKPOINT(); 
TRY_AGAIN; 


ccccecce 


IF PREVCO] NEQ 0 THEN EXITLOOP; ! Extend as needed 
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UN_K_ASSIST 
Request operator intervention 


RIF F 
THEN 


BEGIN 
EXTERNAL ROUTINE 
IST: ADDRESS ING_MODE (GENERAL) ; 


AL 
UTILS_OPERFAIL = SORS_OPERFAIL, 
UTILS. OPREPLY = SORS_OPREPLY; 


L 
REPLY_DESC: VECTOR[2] 
REPLY “BUFF: VECTORC255, BYTE), 


STATU 
REPLY ~peEst 0J RALLOCATION(REPLY BUFF); 


REPLY D ESC 1] = REPLY_BU 
STA S UTILSASSIST (REPLY: _DESCcCOI, Response 
messa 
SOR$_ EXTEND AND NOT STS$M_ SEVERITY “ORs STS$K * ERROR) , 
! Timeout period (in seconds) 
UPLIE CT, SOR$_REQ_ALT)); i Prompt message 
Flsieg 
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TRIES = 0; 
it, REPLY PESCEO) NEQ 0 THEN WORK_OPEN(REPLY_DESCL0]); 
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END; 
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! Try RDBs that had gotten errors 
Mo oe the RDB's from WFB_FULL to “WFB_ FREE 
B 
IL 


! 
' 
i 
WEB = CTXCS_WRK_WFB) - Bol, a WFB_NEXT); 
WHILE (WFB = .WFBCWFB sh 

MOVE _ALL _RDBS_ ( WFBCWFB_ ELI. WFB_FREE ); 

Check how many times we've tried to get more space 
IF (TRIES = .TRIES + 1) LSS K_TRIES THEN TRY_AGAIN; 
At this point, just give up 


SORSSFATAL (SORS$_EXTEND); 
END; 
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' Remove the RDB from the free List 
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REMLH_(PREVCO], RDB, RDB_NEXT); 
Link the RDB at the end of RDB blocks for the current run. 


RUN = CTXES RUN_ CURR]; 
INSLT_(RUNCRON_RDBJ, RDB, RDB_NEXT); ! Insert at end of List 


Copy relevant information into the RUN block 


RUNCRUN_RDB_CURR] = RDBCBASE_]; 
RUNCRUN_VBNJ = .RDBCRDB_VBNT; 


END; 
OOFC 00000 GET_RDB:.WORD Save R2,R3,R4,R5,R6,R7 ; 
57 D4 00002 CLRL ~—sTRIES ; 
51 80000000 8F DO 00004 18: MOVL  #-2147483648, MAX_SIZE ; 
55 7C 00008 CLRQ = PREV ; 
54 00E4 CB 9E 0000D MOVAB 228(R11), R4 : 
52 54 D0 00012 MOVL R4, WFB : 
52 62 DO 00015 2s: MOVL (WEB), WFB : 
1F 13 00018 BEQL -5$ ; 
56 10 A2 CB OOOIA BISL2 16(WEB), ANY_FREE ; 
50 14 A2 9E OOO1E MOVAB 20(R2), CURR~PREV ; 
53 60 DO 00022 3$: MOVL § (CURR_PREV), RDB : 
EE 13 00025 BEQL = 2$ ; 
Oc A3 51 01 00027 CMPL § MAX_SIZE, 12(RDB) ; 
07 18 0002B BGEG © 4$ ; 
51 0c A3 DO 90020 MOVL § 12(RDB), MAX_SIZE ; 
55 50 00 00031 MOVL § CURR_PREV, PREV ; 
50 53 DO 00034 4$: MOVL RDB, ~CURR_PREV 
9 11 90037 BRB ; 
1 D5 00039 5$: TSTL § MAX_SIZE ; 
é 14 00038 BGTR 9$ : 
55 05 00030 TSTL PREV ; 
gE 12 0003F BNEG ; 
52 4 00 00041 MOVL  R4, WFB : 
5 62 DO 00044 68: MOVL (WFB), WFB ; 
11 1 047 BEQL ; 
18 A2 D 49 7$: TSTL 4 (WEB) ; 
F6 13 0004C BEQL 6s 6$ ; 
10 DD 0004 PUSHL #16 ; 
18 Ag 9F 0005 PUSHAB 24(WFB) ; 
0000v CF 02 FB 00 CALLS We. FREE_RDB : 
F 11 000 BRB 7 ; 
7 D6 OO05A 8S: INCL TRIES ; 
03 7 D1 0005C CMPL TRIES, #3 ; 
A319 0005F BLSS =_-‘'1$ ; 
001C80A4 af DD 00061 PUSHL #1867940 ; 
000000006 00 1 FB 67 CALLS #1, SORSSERROR : 
53 65 DO 0006F 9$ MOVL (PREV), RDB ; 
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ROUTINE FREE_RDB( 
¢ REF VECTOR(1), 


wr 


! XFIELDEXPAND(WFB_FREE/NOUSE, 0) 
: CAL_CTXREG NOVALUE = 


AL REGISTER 
X = COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 


“az 


REF RDB_BLOCK, 
REF RDB_BLOCK, 
OFF; 
Get a pointer to the RDB being freed 


= ,QC0); 


aes Gooue 


If we aren't checkpointing, free directly to the WFB_NOUSE List 
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3 1 1 1 3 
s 1 1 | ; 
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3; 1334 1385 1 3 
; 1335 138 ; 
: 1336 138 $ 
: 1337 138 3 
S| Ms 138 3 
3; 1339 139 § 
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: 1341 139 5 
5 1 <g 139 3 
s 154 139 3 
3 1344 133 $ 
3; 1345 139 3 
3; 1346 139 3 
: 1347 1398 2 ; 
: 1348 139 § ; 
: 1349 L 140 ZIF FUN_K_CHECKPOINT 3 
3; 1350 U 1401 2 XTHEN 3 
; 1351 U 140 2 LOFF = OFFSET; $ 
: 1 32 U 140 é IF .CTXCECOM_NOCHKPNT : 
3s 135 U 140 THEN 3 
3 1354 140 2 <I é 
: 1322 Pe 2 LOFF = %FIELDEXPAND(WFB_NOUSE,0); : 
: 1320 rt ; Hook the RDB onto the WFB's free List 3 
3 1359 141 2 R = BBLOCKC.PCRDB_WFB),.LOFF,.0,%BPVAL,0] - BBLOCKCO,RDB_NEXT); : 
> 1360 141 : WHILE (R = .RERDB~NEXTJ) NEQ 0 DO : 
3; 1361 141 BEGIN 3 
3: 1362 141 3 IF .PCRDB_VBN] + .PCRDB_SIZE] EQL .RCROB_VBNI é 
3: 1363 141 3 OR .RCRDB_VBNJ + .RCRDB_SIZEJ EQL .PCROB_VBNJ é 
> 1364 141 ; THEN ; 
3; 1365 141 EXITLOOP; : 
: 1366 1417 2 ND; 3 
3: 1367 141 3 
: 1368 141 IF RCBASE_J EQL 0 3 
3; 1369 142 THE 3 
: 1370 142 BEGIN 3 
3 1371 142 ! : 
3: 1372 142 ' Cannot coalesce the holes 3 
$ 1377 ies Remove from the current List, and add to the free List 3 
: 133¢ 14 REMLH_(QCOJ, P, RDB_NEXT); : 
: 1376 1427 INSLH~ (BBLOCKC .PCRDB_WFBJ,.LOFF,0,%BPVAL,0J, P, RDB_NEXT); : 
3 1377 1428 END 3 
; 1378 1429 ELSE 3 
: 1379 1430 BEGIN 3 
; 1380 1431 | ; 
3 138 1636 ; Coalesce the holes, remove from current List, and deallocate. 3 
3 1 § 143 Ais gt = MINU(.RCRDB yond. PCRDB_VBNJ); | 3 
> 1384 1435 R RDB-si7é] = .PCRDB SIZE) + .RCRDB STZEJ; : 
: 1385 1638 REMLH_(QCOJ, P, RDB_NEXT, RDB_K_SIZE); : 
: ey 143 § END; ; 
; 138 1438 | ; 

i 

| 
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114 bytes, Routine Base: 


: Routine Size: 
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SORSSCR_10 WB-Sep-1984 00:40:52 YAK=t1 Bling-32 v4. 09762 


SORT32.SRCJSORSCRIO.B 


; 1390 1440 1 ROUTINE NEWRUN: CAL_CTXREG NOVALUE = Start a new run 
: 1391 1441 1 

3; 139 1226 1 +4 

3; 139 1445 1! 

: 1394 1444 1 =! FUNCTIONAL DESCRIPTION: 

; 1395 1445 1! 

3; 1396 1778 1! This routine starts a new run. 

: 1397 1447 1! 

3; 1398 1448 1 ! FORMAL PARAMETERS: 

; 1399 1449 1! 

: e's 1039 : CTX Longword pointing to work area (passed in COM_REG_CTX) 
F 1008 1426 1 ! IMPLICIT INPUTS: 

3; 140 1453 1! 

3 1404 1454 1! NONE 

: 1405 1455 1! 

: 1406 1456 1°! IMPLICIT OUTPUTS: 

: 1407 1457 1! 

3; 1408 1458 1! NONE 

3: 1409 1459 1! 

3 1410 1460 1 ! ROUTINE VALUE: 

3 1411 1461 1! 

3 1036 1466 1! NONE 

3 141 1463 1! 

3 1414 1464 1 ! SIDE EFFECTS: 

3 1415 ae 2 ae 

: 1416 1466 1! NONE 

: 1417 1467 1 !-- 

3 1418 1468 2 BEGIN 

3 1419 1469 2 EXTERNAL REGISTER 

: 1420 1470 2 CTX = COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 
: 15) 1471 2 LOCAL 

3 14 § 1076 RUN REF RUN_BLOCK; ! Ptr to run block 
3 14 147 

> 1424 1474 

3: 1425 1475 !' Bump the number of runs 

3 1426 1476 § ! 

3 \est eet § CTXCCOM_RUNS)] = .CTXCCOM_RUNS] + 1; ! One more run batted in 
: Hi 1479 ' Create a run desription block for this new run. 

: 14350 1480 ' Link the new run description block into the List. 

: ioe] tt Find a large hole to hold the merged run 

; 1438 1488 RUN = SORSSALLOCATE(RUN_K SIZE); 

3 1434 1484 INSLH_(CTXCS_RUN_INFO), RON, RUN_NEXT); : 

: 1435 1485 CTXCS"RUN CURR) = RUNCBASE_4; ! This is the current run 
3 1436 1086 RUNCRON_STZE) = 0; ! Nothing written here yet 
3: 1437 148 T_RDBT); 

: 1438 1638 

3: 1439 138 ' Get a buffer for this run 

3: 1440 1490 ! 

3: 1441 1491 GET_BUFFER(RUNCBASE_)); 

: ee 1336 

3; 144 149 END; 
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48 bytes, Routine Base: 


; Routine Size: 


‘ 
sonsseR_10 1B-Sep-1984 00:40:52 YAN-1] BL inn=52 y4-0-742 Page 44 
! 


GLOBAL ROUTINE SORSSWORK_WRITE ! Write to a work file 


SRC_ADDR: REF BLOCK ! Address of internal format record 
on ): JSB_OUTPUT = 


FUNCTIONAL DESCRIPTION: 


This routine writes to a work file. 
FORMAL PARAMETERS: 


3 teeta Address of internal format record 
Longword pointing to work area (passed in COM_REG_CTX) 


! 
i 
i 
i 
i 
' 
i 
i 
i 
i 
i 
IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 
ROUTINE VALUE: 
The address of where the record was written. 
SIDE EFFECTS: 
x NONE 
BEGIN 
aha si _REGISTER 
CTX COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 
LOCAL 
| 
| 


REF RUN_BLOCK, ! Current run block c 
! Length of record to write 


WARIPOPINIPININNININ 2 2 OO OO OS | MDOOOOOOOOCOCOCOOOOOO 
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; STATUS; ! Status 
; RUN = .CTXCS_RUN_CURR); 
$38 ; RUNCRUN_COUNT) = .RI'WCRUN_COUNT] + 1; ! One more record in this run 
4 
89 3 Set the Length and address of the record to be written. 
491 4 LEN = wERON BU LR -INT): 
$38 ? 1F cru RUN_BUFFOJ~= .RUNCRUN_BUFFO] - .LEN) GEQ 0 
494 4 BEGIN 
495 4 LOCAL 
496 4 TMP1; 
497 4 CHSMOVE (. tee SRC ADPACBASE J, «RUNCRUN_BUFF1]); 
498 4 TMP1 = .RUNCRUN -BOFF ATE 
499 4 RUN RUN: “BUFF ~RUNCRUN -BUFF + LEN; 
300 ¢ RET . IMP 1; '“Return address of the output record 


SORSSCR_10 :40: X=11 Bliss-32 V4.0-74 
v04-000" - :10:4 ORTS2° SREISORSCRIO.03951 
ELSE 

RUNCRUN_BUFFO] = .RUNCRUN_BUFFO] + .LEN; ! Reset 


} There isn't enough room in the buffer for this record 


BEGIN 

LOCAL 
MP1, ! U div BPERPAGE * BPERPAGE 
TMP2, ! U mod BPERPAGE 
END; ! BUFFO + BUFF 


We want to return the address of the record, so we must have the entire 
record available in the buffer. 


In the Re hy below, 
U = BUFFER 

Write out the first pact t of the buffer 
LEN: ROUND. (U-BPERPAGE, BPERPAGE) 


Move the remainin Oph tu to the bestnnin Ri: the buffer 
SRCLEN: U (U-BPERPAGE, BPERPAGE) 
SRCADR: BUF FER*ROUND (U-BPERPAGE, BPERPAGE) 
DSTLEN: “ROUND” (U-BPERPAGE, BPERPAGE) 
DSTADR: BUFF ER 
Move the new record into the buffer 
DSTADR: BUFFER+U-ROUND_ (U-BPERPAGE , BPERPAGE) 


: omute ROUND _(U=-BPERPAGE, Hh and 
= ROUND_(0-BPERPAGE, BPERPAGE ) 


VIFWN—OOONAUES WN “OO ONAUE WN HOO ONOUF Wr 


= .RUNCRUN wai - Peete BUFFER: ! This is momentarily U 
TMP2 = - TMP I AND (COM_K -6P ERPAGE-1 
TMP1 = AND NOT (COM~K~BPERPAGE- “133 
BEND = * RUNCRUN. BUF FO) + =RONCRUN _BUFF 13; 


Adjust BUFFO/BUFF1 to indicate a full buffer, and write it out 
RUNERUN. BUFF = 5 RUNCRUN _BUFFER] + .TMP1; 


et Seas 2 3 FOO OOOOCOCO 
WOOO OOO O09 0000 0009 09 09 09 09 09 ISI NII SNP AA AA AAA A MMNMIIIIVIVI 
FW OS VONAUE AN [OO ONA UE WWD O ODNAOUE WN SO OONOUS Ww 
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a ee T_T eee 
DDPPEDQPXE_ PPD PPV PVPS SST SUSU TSS TSS USS ISI SISOS 
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Se Se Oe Se Se Ge Be Se Se Se Be Se Fe Be Se Se Se Se Be Sy Be Ge Se FH Ge Se Se Ge Sse Se Se Se Se Se Se SH Se Se Se Ge Se Se Se FF SHS Ge Se FHS See SHS ese Seas 


7 

8 

9 

0 

1 

2 
43 RUNCR Eyost = 
6 FLUSHCRON BASE 2; 
ri 2 Move the remaining bytes to the beginning of the buffer 
48 7 CHSMOVE (. TMP2 PUR IN BUFFER] + .TMP1, .RUNCRUN_BUFFER]); 
49 98 RUNCRUN_BUFF1) = .RUNCRON_BUFFER] + .TMP2; 

29 3p RUNLRUN “BUF FO = BEND - ~BUNERUN _purria, 

26 4 Move the new record into the buffer 

54 88 CHSMOVE(. LEN, SRC ADDRCBASE J. »RUNCRUN_BUFF1)); 

55 04 ia = .RUNCR BOF 

56 05 UN_BUFFO) = .RUN RUN _BUFFO] = .LEN; 

2 8 RUN RUN “BUFF 1 = ,RUNLRUN_ “BUFFI) + “LEN: 


RETURN JTMP1; 
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RC_ADDR), @28(RUN) 
TMP1 
) 
P 


, 28(RUN) 
8 (SP) 


- RO 


{ 
#24, SP 


‘ 

2 

( 

6 

( 

N 
LEN (Ss 
8 (RUN) 
LEN, @ 


LEN 

es 
EN 

TMP 


RSB 
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Routine Base: 


155 bytes, 


a 
N 
ia) 
a 
Cc 
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se 
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*. 


2 
vou-000" 1E$00r4986 Q0:40:32 YABSYL BLisgc3z ye oo743 P09 233 
: 


63 ROUTINE WRG WORK READ Read a record for merge 
RUNBLOCK: REF RUN_BLOCK ! Address of run description block 
): JSB_INPUT = 


44 

i FUNCTIONAL DESCRIPTION: 

This routine reads a record for a merge, either by 
using RMS to get ce record, or 

calling the user-written input routine. 

i FORMAL PARAMETERS: 


RUNBLOCK Address of run description block 
CTX Longword pointing to work area (passed in COM_REG_CTX) 


{ 

! 

' 

! 

' 

1 

1 

' 

1 

! 

! 

' 

! 

{ IMPLICIT INPUTS: 

NONE 

i IMPLICIT OUTPUTS: 

NONE 

: ROUTINE VALUE: 

Address of record, or zero if end-of-run (end-of-file) 

| SIDE EFFECTS: 

NONE 

"BEGIN 

EXTERNAL REGISTER 

CTX =  COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 

BUILTIN 
| 
} 


MACRO 
RETURN_ = RETURN RO = 2; 


CHSFILL (FILL,DN,DPTR) = 
BEGIN 


BUILTIN MOV 
MOVC5(ZREF ( 
END 2%; 


uM 
en ek ed a a ed ed 8 od od od wd od 8 ed od = = 8 3 = 2 8 2 


PDAEAAAAASAA AAA AA AAAAAAAAAAAAAAHA AAA AAAS AA AA AAAS A AAA A AAA AAO IA AO 


Ss 
§3: oRO, ZREFCFILL), ZREF CDN), DPTR; RO); 


} Read one record from the file 
WHILE TRUE DO 
BEGIN 


LOCAL 
D: VECTORC2); ! Descriptor 


! Grab a pointer to the DDB (if this is a merge with a user-written input 
} routine, this is really the number of the stream for him to read). 


Se Ge Be Ge Se Se Se Se Se Be Se Ge Se Se Se Se Se & Bete Ge Ge Ge Se Ge Ge Ge Ge ee Ge Se Ge Ge Gi Ge Ge Ge Ge ee & Se Ge Ce Ge Se ee Ge Ge Ge Ge Ge Sete ee CHG Ge 
ee ee ee ee ee ce ee ee ce ee ce ce ee ee el ee a ce ch ae a a ce ae ch a a ea cl ee ee ee cl ee ce ed ec ee en ce co cc ee cc eal cl el a nl al al 
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an 
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2 
SORSSCR_10 1h-s6 -1984 00:40:3 AX-11 Bliss-32 V4.0-7 Page 48 
v0e000 12-88-1382 90:18:45 SORT32.SRC SORStRIO.BS9s1 . (22) 
! Note that this assignment is inside the loop, because there aren't 
! any registers that we can use (for DDB) that last across the call 


to the input routine. 


REGISTER 
: REF DDB 
DDB 


DB: E BLOCK; ! Pointer to DDB 
DDB = .RUNBLOCKCRUN_ $ 


I 
Clear this, since the user-input routine only stores a word. 
DCO] = 0; 
| etter i ted NEQ 0 

BEGIN 

If there is a user-written input routine, call it. 

IF_ .CTXCCOM_HACK_2ARGS] 

THEN 


WANN wrrornonororerneroreoreor 


DONAUESWN OC VONAUES WN (“OO ONOUSWN OO ONIOULS WHO 


RO = (.CTXCCOM_MRG_INPUT]) 
ay (RUNBLOCKCRUN_BUFFOJ, 
RO = (.CTXCCOM_MRG_INPUT]) 


%REF(.DDB), DCOI) 


(RUNBLOCKCRUN_BUFFOJ, %REF(.DDB), DCO], .CTXCCOM_CTXADR)); 
fen” «RO 


PAAEAAAAAAAAAAAA AA AAA A AAAS AAA AAA A AAA AS 


me ee ee ee ee td ed ed ad ed ad od ad nd dd ed 2d ed dd wd dt 
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BEGIN 
a NEQ SSS$_ENDOFFILE ! Unexpected error status? 
RO = SORSSERROR(SORS$ _RTNERROR, 0, .RO); 
RETURN. DELRUN(RUNBLOCKCBASE_1J); ' Return 0 to indicate EOF 

DC1] = .RUNBLOCKCRUN_BUFF1); 

CTXCCOM_MRG_STREAM] = .DDB; 

END 

ELSE 

BEGIN 
659 ZIF NOT HOSTILE XTHEN 
661 ' Clear the VFC area 
662 1 i 
64 1 IF .CTXCCOM_MINVFC) NEQ 0 
664 1 THEN 
669 CHSFILL_(O, .CTXCCOM_MAXVFCJ, .CTXCCOM_RHB_INPJ); 
rot : Now get the record 
669 RO = $GET(RAB=DDBCDDB_RAB+BASE_]); 
14 1 : Create a descriptor for the input record 
ore bfO = .DDBCDDB_RAB+RABSW_RSZ); 
674 DC1) = .DDBLDDB-RAB+RABSL RBF J: 
675 CTXCCOM_MRG_STREAM) = .DDBCDDB_FILI; 


D 2 
vos=000" VerSep-1986 WS:10s0d — ESbRTS2esnedsoRstRio. 039; 1 


V4. 
4-00 Sep-19 SORT32.SRCJSORSCRI 
3; 1677 U 1725 4 ZELSE 
3; 1678 U 17 § 4 RETURN_ SORSSERROR(SORS$_SHR_BADLOGIC); 
: 1679 17 4 xFI 
; 1680 1728 END; 
; 1681 1729 
; 1086 1730 IF .RO 
3; 168 1731 N 
3; 1684 17 ¢ 4 BEGIN 
; 1685 17 4 
3; 1686 1734 4 CTXCCOM_INP_RECNUM] = .CTXCCOM_INP_RECNUM) + 1; 
3: 1687 1735 4 
; 1988 17 $ 4 IF 
: 1689 17 5 BEGIN 
; 1690 1738 : ! 
; 1691 1739 ! Check the Length 
3 1096 1740 5 } 
3; 169 1741 : IF .DCO] GTRU .CTXCCOM_LRLI 
> 1694 1706 THEN 
3 1695 1743 6 BEGIN 
3 1696 1744 6 ! 
3: 1697 1745 6 ! If too long, complain and shorten the record 
; 1698 1746 6 ! 
3 1699 1747 6 RO = SORSSERROR(SORS$_BAD_LRL, 1, .DC0) 
; 1700 1748 6 R$_SHR_READERR; 1, DDBLDDB_NAMEJ); 
: 1701 1749 6 DCO) = .CTXCCOM_LRLI; 
3 1708 1750 6 TRUE 
3; 170 1751 6 END 
3 1704 1736 5 ELIF .DCOJ LSSU .CTXCCOM_SRLJ 
3; 1705 1753 5 THEN 
3; 1706 1754 6 BEGIN 
3; 1707 1755 6 ! 
; 1708 1756 6 ! If too short, complain and ignore the record 
: 1709 1757 6 ! 
3; 1710 1758 6 RO = SORSSERROR(SORS_BAD_SRL, 1, .DC0] 
> 1711 1759 6 ORS$_SHR_READERR, 1, DDBCDDB_NAMEJ5; 
> 1712 1760 6 CTXCCOM_OMI_RECNUM] = .CTXCCOM_OMI_RECNUM] + 1; 
3 1713 1761 6 FALSE 
3 1714 1788 END 
3; 1715 176 ELSE 
3 1716 1764 TRUE 
3 1717 1765 5 END 
3; 1718 1708 4 THEN 
3: 1719 176 BEGIN 
3 1730 1708 ! 
3; 1721 179 ' Convert the record to the internal format, and return the 
: 4 g 1700 address of the internal format record. 
3 1724 HA 6 IF NOT (RO = JSB JUTE SEL SON INPUT, pCO), 
3; 1725 177 -RUNBLOCRCRUN_BUFFER))) 
: 17 $ 1774 THEN 
3; 17 1775 CTXCCOM_OMI_RECNUM) = .CTXCCOM_OMI_RECNUM) + 1 
3; 1728 1776 ELSE 
3 1729 177 RETURN_ .RUNBLOCKCRUN_BUFFER); 
3: 17 1778 4 END; 
; 1731 1779 4 END 
3: 17 ; 1780 4 ZIF NOT HOSTILE ZTHEN 
3; 17 1781 3 ELIF 
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2 | 
SORSSCR_10 1b-5e 1984 00:40:3 AX-11 Bliss-32 V4.0-74 Page 50 
voe~ 000" 1 ~Sep-19 4 99:98:25 SORTS2 SRE SORSCRIO.B $31 . a 
: 1734 17 ¢ ; «RO EQL RMSS$_RSA ! Record Stream Active | : 
: 17 : 1784 4 RO = SWAIT(RAB=DDBCDDB_RAB+BASE_J) ! Wait until not so active | : 
; 17 1785 ELIF : 
: 1738 1786 «RO EQL RMS$_RLK : 
: 1739 17 THEN | 3 
: 1740 1788 4 BEGIN 3 
3; 1741 1789 4 ' ; 
3 1o06 1790 4 ! Try setting the ‘read regardless of lock’’ bit. : 
3 174 1791 4 ' If we had already tried that, exit with the error. ; 
: 1744 1036 4 ! 3 
> 1745 1793 4 BUILTIN | ; 
: 1746 1794 4 TESTBITSS; : 
3 1747 1795 4 IF TESTBITSS(BDBCDDB_RAB+RABSV_RRLJ) THEN EXITLOOP; : 
> 1748 1796 4 RO = SORSSERROR $ 
: 1749 1797 & SORS$_SHR_READERR AND NOT STSSM_SEVERITY OR STSSK_WARNING, : 
; 1750 1798 4 1, DBBCOBB_NAME | : 
3 1751 1799 4 .DDBCDDB RAB+RABSL_STS], -DDBCDDB_RAB+RABSL_STV), | : 
: Tae 1800 4 RMS$_OK_RRL); 
; 175 1801 4 END 
: 1754 1906 4 FI 
3; 1755 180 ; LSE 
; 1756 1804 EXITLOOP; ! Some other error | 
: 1757 1805 2 END; | 
: 1758 1806 
: 1759 1807 
; 1760 1808 ! Check for the expected status | 
; 1761 1809 ! 
3 1706 1810 IF .RO NEQ RMS$_EOF 
: 176 1811 THEN 
3 1764 i3i¢ BEGIN 
3; 1765 181 REGISTER 
: 1766 1814 DDB: REF DDB_BLOCK; ! Pointer to DDB 
3; 1767 1815 DDB = .RUNBLOCKCRUN_DDBI; 
; 1768 1816 3 RO = SORSSERROR(SORS_SHR_READERR, 1, DDBCDDB_NAME], 
: 1769 1817 -DDBCDDB_RABRABSL_STSJ, .DDBCDDB_RAB+RABSL_STV)); 
: 1770 1818 2 END; 
3; 1771 1819 2 
; HA 1820 2 RETURN_ DELRUN(RUNBLOCKCBASE_)); ! Return 0 
; 177 1821 1 END; 
-EXTRN SYSSGET, SYSSWAIT 
5A DD 00000 MRG_WORK_READ: 
~ PUSH a8 ; 1611) 
5E C C2 000 SUBL #i2, SP : 
9 DD 000 PUSH R9 : 
51 6E 04 C1 4 1$ ADDL #4, RUNBLOCK, R1 > 1674 
56 61 D0 908 move (Ri), DDB 
08 AE D4 000 : CLRL D ; 1679 
52 60 AB OD Bh MOVL 96(CTX), R2 ; 1681 
5A 1 : 13 BEQL 6 : 
59 6E 18 C 1 ADDL3 #24, RUNBLOCK, R9 : 1690. 
11 SCAB 05 £1 00018 BBC #5, 92(CTX), oe : 1687 
08 AE 9F 2 PUSHAB D ; 16 


F 2 


SORSSCR_IO 16-Sep-1984 00:40:3 AX-11 Bliss-32 V4.0-74 
$002 000 1 mt 1 90:10:28 YeoRT 2.SRC SoastRin. 63351 
08 AE 56 00 00 MOVL DB, 8(SP) 
08 A oF ; PUSHAB 8(SP) 
59 DD A PUSHL 
62 6 FB C CALLS #3, (R2) 
11 F BRB . 
54 AB po 0031 2$: PUSHL  84(CTX) 
OC AE 9F 00034 PUSHAB 
OC AE 56 00 99 7 MOVL DDB, 12(SP) 
0c AE 9F 00038 PUSHAB 12(§P) 
59 DD 000 PUSHL R 
3 BS EE S38 og, GAAS Hs 
00000870 = BF 8 D| 0946 CMPL RO: #2160 
11 13 00040 BEQL 4$ 
50 oD OO4F PUSHL 
7E D4 00051 CLRL 5(§ ) 
001¢812A 8F DD 00053 PUSHL #1868074 
000000006 00 3 FB 00059 CALLS #3, SORSSERROR 
0120 31 9060 4$: BRW 
51 6E 1C C1 00063 5$: ADDL3 #28, RUNBLOCK, R1 
OC AE 61 DO 90067 MOVL (RIS, D+4 
64 AB 6 DO 00068 MOVL DDB, 100(CTX) 
2c (11 0006 BRB 
0081 ¢B 95 00071 6$: TSTB =: 129(C TX) 
0d 13 00075 EQL 
51 0082 CB 9A 90077 MOVZBL 130(CTX), R1 
51 00 00 2c 0007¢ MOVCS #0, (RO). #0, R1, @140(CTX) 
008c oB 00081 
14 A6 9F 00084 7S: PUSHAB 20(DDB) 
000000006 00 01 FB 00087 CALLS #1, SYSS$GET 
08 AE 36 AG OC 9008 MOVZWL 54(DDB), D 
OC AE 3¢ = A-s«: 0009 MOVL 60 (DDB). D+4 
64 AB 58 3=6A6 9A 0009 MOVZBL 88(DDB). 100(CTX) 
7B 50 €9 0009D 8$: BLBC—séaR 
7¢ «=AB O6 SOQ INCL 124(CTX) 
08 AE 0084 CB 10 00 ED 000A CMP72V #0, #16, 132(CTX), D 
25 1E OO0AB BGEQU 
04 Ad 9F OOOAD PUSHAB 4(DDB) 
1 DD 0008 PUSHL @# 
001¢10B2 8F DD 0008 PUSHL #1839282 
14 AE DD 0008 PUSHL 0D 
1 DD 00088 PUSHL 
001¢8082 8F DD 0008 PUSHL #1867906 
000000006 00 6 §B 000C CALLS #6, SORSSERROR 
AE 0084 5 3¢ CA MOV ZL g(CTX), D 
08 AE 0086 CB 10 0 FD Obe 9$: CMPZV #0, #16, 134(CTX), D 
F 1B QOODA BLEQU 1 
04 AG 9F 000DC PUSHAB 4(DDB) 
0 DD OO0DF PUSHL @ 
001¢1082 F DD 000E1 PUSHL #1839282 
AE DD O00E7 PUSHL 0D 
DD OOOEA PUSHL 
OO1C80F8 BF DD OO0E PUSHL #1868024 
000000006 00 6 FB F CALLS 6 SORSSERROR 
1 F BRB 11§ 
59 08 AE 9€ OOOFB 10$:  MOVAB. D, RO 
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#6, SORSSERROR 
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us RUNBLOCK, R2 
28(DDB), -(SP) 
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g.s6 : 740: -11 Bliss-32 V4.0-74 } Page 3 
yoes8007 1073801 $8e 99:18:28 Sort 2-SRC SoRscRi0.639;1 (23) 
v04-000 : 


1s § 1 ROUTINE FILL Read from a scratch file | 
3 177) ion block ; 
: 1 1 ; K, |! Address of run descriptio | ; 
; 177% i 2 } _Piaepecoin REF VECTORE S41 i Length/address ; 
ts 18 é J88_INPUT = 
; 1 : 
; 1781 18 8 eeTeRA =  COMCREG.CTX: REF CTX_BLOCK_(S_FIELDS); | 
3 if yay ‘ 
; 1788 183 LOFARUN: REF RUN_BLOCK; | 
: 1785 18 : LOCATOSB: — VECTORC4, WORD]; | 
1787 1836 RUN = RUNBLOCKCBASE_); | 
: 1836 ; 
: 1588 1837 WHILE PCO GTR 0 DO | ; 
; 1791 ; 
; 1738 1373 LOCA DB: REF RDB_BLOCK. | 3 
: 1794 104) +4 ao hme ! Number of blocks to write | ; 
> 1795 1 , 3 
; 1796 1848 : Compute the number of blocks we will read 
1798 1a? RUNCRUN_RDB_ CURR}; 
? 1799 1846 UPB = :RDBCRDB-UPBIs ; 
i 1801 9h S12 CO] =LN2_(COM_K_BPERPAGE) | : 
: 1808 138) "RDBLRDB VENT -ROBCROB_SIZE3 - .RUNCRUN_VBNJ, | ; 
7] he itis | : 
: 1851 . ; 
: 180s 1826 SIZE EQL 0 ! Was this RDB depleted? | 
: 180% 1835. MNBEGIN 1, WEB FREE) | 
RDB), : 
: 1808 1856 RUMERONC ROG CORR == ROME ROR ROE bea! 
; 1810 1857 4 RDB = UN RDB_CURRI; : : 
3 181) 1328 ¢ IF RDBEBASE.) EQL 0 THEN EXITLOOP; | 
; 1813 1860 d RUNCRUN_VBNJ = .RDBCRDB_VBN); | ; 
‘ D ° 
; 1814 1861 4 N | 
: 1815 136 7 BEGIN | 
; 1816 sez 2 LOCAL 
; i818 1865 4 STATUS; ; 
* 181 1866 4 ( F 
: 1830 P 186? 4 seaaay : Be wees” S_WRK_EFN, | : 
: 1821 e 1968 4 CHAN= .WFBCWFB_CRAN), ; 
: 188¢ cits 2 FUNC= i0$ READUBLK, | 
3 1 P ! y 4 10SB= OS5, | ; 
+ 1826 P1872 6 ASTADR= 0, ; 
; 1895 eee 2 ASTPRA= 0, ; 
31 $ 2 2 Pes SIZE LNZ_(COR_K_BPERPAGE) ; 
; 1898 P ! 6 ? a4 6 HOSTILE ELAN-ETNEN, , ELAM = ~CTXCCOM_CTXADR] 2FI ); : 
° =. 0 

1839 1878 4 IF .STATUS THEN™S 
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; Routine Size: 
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K 2 
SORSSCR_10 16-Sep-1984 00:40:3 AX-11 Bliss-32 V4.0-74 Page 56) 
04-800 erSep-tope 19:10:45 — ESOntdzesneSsonstRio.039;1 (28) 

| a 

; 136 131% | GLOBAL ROUTINE SORSS$WORK_READ ! Read from a work file ‘ 
; 1868 1914 1 RUNBLOCK: REF RUN_BLOCK ! Address of run description block | ‘ 
; 1869 1915 1 ): JSB_INPUT = . 
> 1870 1318 1 {++ | 
3 1871 wir + s¢ 
: 1876 1918 1 ! FUNCTIONAL DESCRIPTION: :¢ 
; 187 1919 1! :¢ 
> 1874 ven 1 | This routine reads from a work file. ‘ ‘ 
; 1875 1921 1! : 
>; 1876 19 § 1 ! FORMAL PARAMETERS: e¢ 
; 1877 19 1! :¢ 
; 1878 1924 1! RUNBLOCK Address of run description block e 4 
; + te 4 12 ; : CTX Longword pointing to work area (passed in COM_REG_CTX) : 
; 1881 1927 1 ! IMPLICIT INPUTS: + ¢ 
; er 1928 1! : ‘ 
; 188 94 1! NONE : 
> 1884 1930 1! i ¢ 
; 1885 1931 1 ! IMPLICIT OUTPUTS: | 
; 1886 1936 1! ‘4 
; 1887 1933 1! NONE + ¢ 
> 1888 1934 1! | 
3 1889 1935 1 ! ROUTINE VALUE: :¢ 
; 1890 1936 1! ‘ s¢ 
; 1891 1937 1! Address of record, or zero if end-of-run. e¢ 
; 1896 1938 1! a ¢ 
; 189 1939 1 ! SIDE EFFECTS: :¢ 
3 1894 1940 1! + ¢ 
; 1895 1941 1! NONE 2 ¢ 
; 1896 Reg 1 !=- . ‘ 
3 1897 194 § BEGIN : 
: 1898 1944 EXTERNAL REGISTER 
> 1899 1945 2 CTX =  COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 
: 1900 1946 § LOCAL 
: 1901 1947 RUN: REF RUN_BLOCK, 52 
; Ie 1948 2 LEN; ! Length of record 
; 190 1949 LOCAL 
: 1904 1950 IOSB: VECTORC4,WORD); 
: 1905 1951 
: 1906 1926 RUN = RUNBLOCKC(BASE_); 
: 1907 195 
:; 1908 1954 
; 44 1332 If we were invoked for a merge, call MRG_WORK_READ to get the record 
: 1911 1957 IF .CTXCCOM_MERGE) 
: ba 1958 THEN 
3; 191 1959 RETURN MRG_WORK_READ(RUNCBASE_]); 
3 1914 1960 
: 1915 1961 
3; 19%% 1306 RUNCRUN_COUNT) = .RUNCRUN_COUNT] = 1; ! One less record 
1917 1963 IF .RUNDRUN_ COUNT) LSS | 
> 1919 1965 RETURN DELRUN(RUNCBASE_}); ! Return now if no more records | 
: 1920 1396 
3 1921 196 
3: 1922 1968 ! Set the Length of the record to be read. 


2 
SORSSCR_10 18-50 “1984 00:40:3 AX-11 Bliss-32 V4.0-74 pene 87 
y0ee0007 eRe) aR Ld te hd Pe We 29° 24) 


7 
| 
: 1923 1369 ! 
i 199% 1970 LEN = .CTXCCOM_LRL_INT); | 
: 1925 1971 
; 19 § 1306 
; 4 4 + tf If everything fine, return now with the address of the record. 
; 4 ! | 
: 1929 1975 iF (RUNCRUN_BUFFO] = .RUNCRUN_BUFFO] - .LEN) GEQ 0 | 
; 1930 1378 THEN | 
: 1931 197 peGine | 
3 19 § 1978 RUNCRUN_BUFF1) = punt hum putr3 + .LEN; ! Next free byte 
; 13 1303 RETURN .RUNCRUN_BUFF1) = .LEN; | 
; 1935 1981 ELSE 
3 yy $ ¢ RUNCRUN_BUFFO] = .RUNCRUN_BUFFO] + .LEN; ! Reset 
: 1938 1984 | 
; 1939 1985 ! Not all of this record is in the buffer. 
: 1940 1986 i | 
; 1941 198 ! We move the first part of the record backwards in the buffer, so that 
; 1306 1988 ! the first part ends at a page boundary. Then we request that the rest 
3 194 1989 ' of the buffer be filled. 
: 1944 1990 | 
3; 1945 1991 BEGIN 
> 1946 1998 LOCAL | 
3 1947 199 TMP, 
3 1948 1994 P: VECTORC2); 
3 1949 1995 r 
3; 1950 1996 ! Compute the address of the next free oyte following the copied string. 
s 132) p44 Then actually copy the first part of the string. | 
; 1988 1999 PC1] = .RUNCRUN_BUFFER] + ROUND_(.RUNCRUN_BUFFOJ, COM_K_BPERPAGE); | 
3 1954 2000 TMP = .PC1) = .RUNCRUN_BUFFO): 
: 1995 2001 CHSMOVE(.RUNCRUN_BUFFOJ, .RUNCRUN_BUFF1, . TMP); 
: 1387 2008 Set BUFFO/1 to the length/address of the start of the (moved) record. | 
: 1959 005 RUNCRUN_BUFFO] = .RUNCRUN_BUFFO] + .RUNCRUN_BUFF1) - .TMP; 
> 1960 006 RUNCRUN-BUFF1) = .TMP; 
3 1961 007 
3 1308 008 ' Set up for the read 
3; 196 009 ! 
3 138 Big PCO] = .RUNCRUN_BUFF1) + .RUNCRUN_BUFFO] - .PC1); 
3 1 81g ' Fill the buffer 
3; 196 01 : 
: 13e8 Bie IF NOT FILL(RUNCBASE_J, PCO)) 
F 1970 O16 RETURN DELRUN(RUNCBASE_)); ' Return 0 to indicate end of file 
: 1376 018 RUNCRUN_BUFFO] = .RUNCRUN_BUFFO) - .LEN; 
3 197 019 RUNCRUN_BUFF1) = .RUNCRUN_BUFF1) + .LEN; 
> 1974 020 RETURN -RUNCRUN_BUFF1) = -LEN; | 
; 1975 021 END; 
: 1976 0 § 
3; 197 0 END; 
| 
| 


Pima i a 
| M 2 
SORSSCR_10 6-Sep-1984 00:40:3 AX-11 Bliss-32 V4.0-74 P 
v04-000 o28ep-198¢ 13:48:25 eSReTSORSCRIO.B35: 1 niyo ; 


} 
| 
5A DD 00000 SORSSWORK_READ:: 
OSH R1 : 1912 
SE 1¢ C2 00 SUBL2 #28, SP : 
59 BD 0 PUSHL RUNBLOCK + 1952 
5¢ AB 00 TSTB. =: 92. CTX) + 1957 
08 18 BO00A BGEQ ~=«'1$ : 
59 of p60 000¢ MOVL RUN, R9 + 1959 
FDAS 30 9000F BSB MRG.WORK_READ : 
50 6E 36 C1 3oo14 1$: ADDL3 #32, RUN, RO + 1962 
60 07 00018 DECL iy : 
50 6E 20 C1 OOO1A ADDL3 #32, RUN, RO + 1963 
60 DS OO0iE TSTL (ROS : 
0 18 000 BGEG $ : 
0086 31 000 : BRW $ : 
OC AE 0088 CB 3C 00025 2$: MOVZ2WL 136(CTX), LEN + 1970 
50 6E 18 C1 00028 ADDL3 #24, RUN, R + 1975 
04 AE 60 SE 0002F OV (ROS, 4(SP) : 
04 BE 0c AE C2 00033 SUBL LE " : 
16 1 00038 oa F 
50 6E 1C C1 O003A ADDL3 #28, RUN, RO : 1978 
60 Oc AE CO S005 ADDL LE * (ROS : 
50 6E 1¢ €1 0004 ADDL3 #28. RUN, RO + 1979 
59 60 OC AE C3 00046 SUBL3. LEN, (ROS, R9 ; 
50 59 DO 00048 MOVL 9, RO : 
74 11 QOO4E 3$: BRB : 
04 BE OC AE CO 00050 4$: ADDL2 LEN, a4(S : 1982 
50 04 BE OOOOO1FF 8F C1 0005 ADDL3 #511, a4(SP), RO : 1999 
50 O1FF 8F AA 00056 BICW 511, RO ; 
51 6 14 C1 0006 ADDL3 #20, RUN, R1 : 
14 AE 5 61 €1 00067 ADDL (R15, RO, P+4 : 
56 14 AE 04 BE C3 0006C SUBL3 a4(SP), P+4, TMP : 2000 
50 6E 1¢ C1 00072 ADDL3 #28, RUN, RO : 2001 
08 AE 60 9E 00076 MOVAB (ROS, 8(§P) ; 
59 08 BE 06 0007A MOVL  a@8(SP), R9 ; 
66 69 04 BE 07E MOVC3 a4(SP). (RO), (TMP) : 
50 04 8B 08 BE C1 0008 ADDL3 a8(SP). a4(SP), RO : 2005 
04 BE 5 6 C3 00089 SUBL3. TMP, RO, a4(SP5 ; 
08 BE 56 D0 0008 MOVL. TMP, a&(SP) : 2006 
50 08 BE 04 BE C1 0009 ADDL3 a4(SP), a8(SP), RO : 2010 
10 AE 20 14 AE 3 909 SUBL3 P+4, RO, P : 
A 10. AE 9 MOVAB P, R10 + 2014 
59 6 p OOA MOVL RUN, R9 : 
FEA OOA BSBW FaLL ; 
09 50 £8 000A BLBS RO, 6$ ; 
6— DD OOAB 5$: PUSHL > 2016 
0000v CF 1 Fe OAD CALLS #1, DELRUN ; 
. 3 0082 BRB 7$ ; 
04 OC AE C2 000B4 6$: SUBL2 LEN, @4(SP) > 2018 
8 BE o¢ AE ¢ B9 ADDL2 ~— LEN, a8 (SP) > 2019 
50 8 BE C Ns ¢ BE SUBL LEN. ag(SP), RO ; 920 
E ‘ C C4 7$: ADDL2 #32, SP : 20 
A E p 99 (7 MOVL (SPS+, R10 : 
OCA RSB : | 
} 


N 2 
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; Routine Size: 203 bytes, Routine Base: SORSRO_CODE + 082D 


3 
sonsscn 10 1B-Se0-1986 09:40:52 YaN-1] BL ieg-32. v4 0-762 Page 60 
' 


; 1309 8 ¢ } GLOBAL ROUTINE POSITION ! Position to start of run : 
; 1981 026 1 RUNBLOCK: REF RUN_BLOCK ! Run to be positioned to : 
; 1986 027 1 ): CAL_CTXREG NOVACUE = ; 
; 198 028 1 !4+ ; 
: 1984 029 1! 3 
; 1985 030 1 ! FUNCTIONAL DESCRIPTION: : 
3 1386 031 1! 3 
:; 198 0 ¢ 1! This routine positions to a run in a work file. ; 
; 1988 Oss 1 3 It also starts reading that run. : 
; 1989 034 1! 3 
3; 1990 83? 1 ! FORMAL PARAMETERS: : 
: 1991 036 1! 4 
: bas) 037 1! RUNBLOCK Address of run description block to be positioned to F 
3 ib ad bee ! CTX Longword pointing to work area (passed in COM_REG_CTX) : § 
3; 1995 040 1 ! IMPLICIT INPUTS: a 
: 1996 041 1! a¢ 
; 1997 204g 1 NONE re | 
3; 1998 204 1! s¢ 
3; 1999 2044 1 ! IMPLICIT OUTPUTS: : 2 
; 2000 2045 1! : 2 
; 2001 2046 1! NONE 3 ¢ 
; 200 2047 1! 3 ¢ 
3; 200 2048 1 ! ROUTINE VALUE: : 2 
3 2004 sop 1! 32 
; 2005 050 1 | NONE :¢ 
3; 2006 soe 7 3 $< 
: 2007 O36 1 ! SIDE EFFECTS: : 2 
; 2008 2053 1! : 2 
3; 2009 2054 1! NONE 3 ¢ 
3; 2010 2055 1 !-- 3 ¢ 
3; 2011 2056 2 BEGIN : 2 
; $o18 aH é EXTERNAL REGISTER $< 
> 201 058 2 CTX =  COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 3 2 
> 2014 2059 2 LOCAL : : 2 
: 2015 2060 2 RUN: REF RUN_BLOCK, ! Pointer to run block 8¢ 
; sos 2061 § STATUS; s¢ 
: 2017 $066 LOCAL : 2 
; at 2063 2 : VECTOREG2. 3 ¢ 
3; 2019 2064 10SB: VECTOR(4, WORD); : 2 
: $054 ae i 
: $0 § 2067 Get a pointer to the run description block, and a buffer for the run : ; 
3 2024 2069 RUN = Runal OCK ERASE. 
3 2025 2070 GET_BUFFER(RUNLBASE_ J); 
3 $58 071 
3 20 Bre 
3; 2028 07 ' Set up for the read. 
: 2029 074 ! Set the starting virtual block address of this run. 
: 3 , ae? : Set the Length and address of the buffer. 
: 052 $75 RUNCRUN RDB CURR] = |. RUNCRUN, RDB]: | 
: 05 078 RUNCRUN-VBNJ = .BBLOCKC.RUNCRUN_ROB_CURR),RDB_VBN); 
: b3 $80 PCO) = MINU(.RUNCRUN_BUFFO), .RUNCRUN_SIZEJ*LN2_(COM_K_BPERPAGE)); 

| 

| 


0 
Q 
0 
0 
8 
08 
08 
08 
09 
09 
09 


4 
5 
6 
? 
8 
9 
0 
1 
2 


—nr 


; Routine Size: 


3 
1b-se 1984 4 
12-808 - 1 3b 9 i$ 
PC1] = .RUNCRUN_BUFFER]; 
Fill the buffer 
IF NOT FILL(RUNCBASE_J, PCOJ) 
THEN 
ere 
RUNLRUN_COUNT] = 0; ! Indicate end of 
RETURN; 
END; 
END; 
O6FC 00000 ENTRY 
5E 10 C2 BRRRE SUBL2 
57 04 aC 00 0000 MOVL 
57 DD 00009 PUSHL 
FOF8 = =CF 01 FB 00008 CALLS 
10 A? 24 AZ? 00 00010 MOVL 
50 10 A? 00 00015 MOVL 
08 A7 08 a0 be 00019 MOVL 
Oc A? 09 7 $4 ASHL 
59 18 A? 00 0002 MOVL 
50 59 D1 Bnos. CMPL 
03 1B Q0O02A BLEQU 
59 50 00 Boose MOVL 
08 AE 59 DO O002F 1$: MOVL 
0c AE 14 A7 00 00033 MOVL 
SA 08 ag 9E 00038 MOVAB 
59 5 B° 0003C MOVL 
FE3B 30 0003F BSBW 
03 50 €8 Benes BLBS 
20 A? D4 0004 CLRL 
04 00048 2$: RET 


Routine Base: SORSRO_CODE + 08F8 


SORT32.SRCJSORSCRI 


POSITION, Save R2,R3,R4,R5,R6,R7,R9,R10 
RUNBLOCK,, RUN 
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> 3 | 
SORSSCR_10 16-Sep-1984 00:40:3 AX-11 Bliss-32 V4.0-74 Page 62 
voe=000 13280871386 99:40:28 {Sort 2.SRC SoRstRiO.639;1 (285 
; $08 99? } ROUTINE DELRUN ! Indicate this run is through : 
: 2051 035 1 RUNBLOCK: REF RUN_BLOCK ! Run description block : 
> 20 ¢ % 1 ): CAL_CTXREG = : 
Be BBE dis 2 
; 035 039 i FUNCTIONAL DESCRIPTION: 3 
; 037 191 ! This routine indicates that processing for a run is complete. | 3 
3 039 i || FORMAL PARAMETERS: ; 
: 2061 105 1! RUNBLOCK Address of run description block of run to delete ; 
. $08 196 : CTX Longword pointing to work area (passed in COM_REG_CTX) : 
; 064 108 1 { IMPLICIT INPUTS: ; 
; 109 1 | : 
it oe at aE oes 7 
: 2068 118 1 | IMPLICIT OUTPUTS: ; 
4 Eee : 
: g07¢ 116 1 | ROUTINE VALUE: : 
Be BY] oe yA. 
: 307% 120 1 | SIDE EFFECTS: : 
tei = 7 
: 2080 124 2 BEGIN ; 
: 2081 125 EXTERNAL REGISTER ; 
3 08 6 cocat =  COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); : 
: 2084 158 P: REF RUN BLOCK, F 
: 2085 129 Q: REF VECTORC1), 3 
3 2086 130 R: REF RDB_BLOCK, ; 
; 087 STATUS; : 
: 2089 1 : 
3 Boe : 3 : One less outstanding run : 
i 309 136 CTXCCOM_RUNS] = .CTXCCOM_RUNS] - 1; ! One Less run ; 
i 2094 138 ! Free all RDBs connected to this RUN block : 
; 096 140 Q = RUNBLOCKCRUN_RDB); ; 
; 209 141 RUNBLOCKCRUN_RDB CURR} = 0; ; 
; O98 14¢ MOVE_ALL_RDBS_( OC0J, wFB_FREE ); : 
: 2100 144 ! Find the run description block in the List of active runs, ; 
; 19¢ 1¢7 and remove it from this List. : 
5108 109 Q = CTXCS_RUN NFO; | ; 
> 21 148 WHILE (P = .0T0)) NEQ 0 DO | ; 
3; dics 14 BEGIN ; 
| 
| 
| 
} 


3 

SORSSCR_IO these -1984 00:40:3 AX-11 Bliss-32 V4.0-74 Page 63. S 
v04- a aet 90:98:28 SORT32.SRC SoastRin.o39:1 ° 28) Vv 
> 21 21 If PCBASE_] EQL RUNBLOCKCBASE_] THEN EXITLOOP; ‘ 
3 1 131 ; 5 PERUNZNEXTY ; chert | : 
: 21 1 : IF PCBASE_) EQL 0 : 
: 119 154 THEN F 
3 i i 5 RETURN SORSSFATAL(SORS_SHR_BADLOGIC); |! We couldn't find it : 
: 11g 1 § ' Free the buffer associated with this run. | ; 
3 Br } 8 ; Unlink and deallocate the run block. : 
: 211 160 FREE _BUFFER(PCBASE )); ' Free this run's buffer . 
; iN} 19) REMLA_(QCO0J, P, RUR_NEXT, RUN_K_SIZE); ! Unlink this RUN block ; 
: 2119 168 ' Return zero, since most of our callers want to immediately return 0 : 
3 ; » i ; after calling us. ‘ 

: 31 é 166 RETURN 0; i 

: 21 167 1 END; : § 

+ 

001C 00000 DELRUN: .WORD $3 e R2,R3,R4 : 2093 : § 
AB B7 900¢ becw © T22ecTxs + 2136 : 

53 04 AC DO 900 MOVL RUNBLOCK, R3 + 2140 3 ¢ 

52 4 A’ 9E 00009 MOVAB 36(R3), Q : 3 

A304 00000 CLAL 16(R3) : 2141 3 4 

62 b 0010 1$: TSTL (Q) + 2142 :¢ 

98 1 901 BEQL 28 : i ¢ 

10 Dd 0001 PUSHL #16 ; 2 ¢ 

32 DD 0016 PUSHL Q F : ¢ 

FB49 CF 02 FB 91 CALLS #2, FREE_RDB : : ¢ 

Fl 11 9 1D BRB 1$ ; 3 ¢ 

52 00D8 cB 9 0 O1F es MOVAB 216(R11), Q : 2147 3 

54 DO 00024 3$ MOVL (Q), P > 2148 3 

A 13 00027 BEQL 4$ 3 g 4 

53 4 01 38 CMPL P, R3 3 2150 $4 

95 1 C BeQL «ss 4 $$ ; : ¢ 

52 4 0 0 f MOVL P, + 2151 34 

Fi 11 000 BRB bt} 3 214 3 4 

54 3 0033 4$: TSTL P 3 215 | 

— 1 BNEQ 5$ ; 2 ¢ 

001C1124 F DD PUSHL #1839396 3 2155 34 

000000006 00 1 FB 3 CALLS #1, SORSSERROR : i 4 

54 DD 00045 SB: PUSH. : 2160 : 

F701 CF 1 FB CALLS #1, FREE_BUFFER 3 3 4 

4 0D ¢ SHL (PS > 2161 34 

DD PUSHL @Q : 3 4 

DD PUSHL #40 ; 34 

000000006 00 FB CALLS a. SORSSDEALLOCATE ; i 4 

p CLAL R : 3166 3 4 

4 8 RET > 2167 : 4 

; Routine Size: 92 bytes, Routine Base: SORSRO_CODE + 0941 : 

e 4 


F 53 
vo0-000 We=$ep-198e 19:10:49 ESdarS2esnedsonscnio.8s9; 1 Page 8) 


3 
vou-0007 if gen- 198 1:70:28 ESbarS°SaeSsonscnio.es3,1 Page 2§} 
ROUTINE WORK OPEN 


FNS: REF VECTOR(2) ! Work file name string 
) : CAL_CTXREG NOVALUE = 


FUNCTIONAL DESCRIPTION: 


MEWN—"OOONOu 


| 
| 
This routine creates/opens the work files. | 
FORMAL PARAMETERS: 
FNS on string of work file to be opened (optional) 
Hh seeetet*enly'ene wort Fite Te atarege tse ove cwenes | 
CTX Longword pointing to work area (passed in COM_REG_CTX) 
IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 
ROUTINE VALUE: 
NONE 
SIDE EFFECTS: 


CTXCS_BUF_SIZEJ is calculated. 


a a a bn © as — as os as Ln ss a a tt ss ss 


COD OOOOOOWDWOWOWDOOOON NNN NINO O 


BOS OS Fo eee 
OWONAWNE WN $$ SO ODNOA NEW 0 OD NOAU EWN HC ODNOUS WN OOO 


BEGIN 
EXTERNAL REGISTER 
CTX = COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 


WRN OC OONOUE WN "OC OONOUS WOO 


XAB for file protection 
Status 


BUILTIN 

NULLPARAMETER; 
LOCAL 

F SFAB_DECL, ! FAB for the work file 

NAM: SNAM yh VOLATILE ' NAM for the work file 

FNA:  VECTORECNAMSC _MAXRSSLCL.BYTE], | File name string 

FB: REF WFB_BLOC ' Pointer to WEB for work files 
REF VECTORC1,LONG), | Addr of pointer to WB 
' 


WFB_PTR: 
XABPRO: $XABPRO_DECL, 
STATUS; 


Set the default extend amount to half the tree size 
CTXCS_WRK_DEQ] = MAXU( 
-CTXCTOM_TREE_LEN] * -LN2_ (COM K_BPERBLOCK®*2), 
TUN_K_BUFSIZE~/ COM_K_BPERBLOCR); 


Get an event flag to use for work file 1/0 


weiaiiwoiwdaiaswiadaabwdaadsdabwdiadaaisdtadwiaiaabdaataaiabuiaabababababababababab aD aba adadbab ad ad acdad ded 
DONO UNSW 0 OONn 


ONIN NN ae SF SSNS SS Fo at at at et ee ot te 
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PIPIPIPIPOPSPIPIPININININININININN — 
_ 
oO 
PORoROPOPORONOPOPOPONOPONOPOMUNPOPOPUNINIDINID 4 9 9 9 


Fwy OC OONOUS wn 


RoMONONPOR) @ a Oo 


Roproronopopory 


H 3 | 
vouro007 1e-38b2138e 99:98:28 4 HeGardo°sneisoastnig.oss. 1 Page § 


-—o 


| 
| 
: 2) ¢ 5 ZIF NOT HOSTILE ZTHEN | 
; 21 § STATUS = LIBSGET EF (CTXCS_WRK_EFNI); 
: : ¢ if NOT .STATUS 
$ ; : 5 . RETURN SORSSERROR(SORS_SHR_SYSERROR, 0, .STATUS); 
: 2188 1 | 
: 189 bp 328¢ $FAB_INIT( | 
; 2190 P FAB = FAB BASE..J. 
; 2191 P 4 NAM = NAMLBASE_J, 
§ 138 P 5 FNA = FNALO], 
3 219 Pp $ ! FNS = 0 ! Set below 
> 2194 P DNA = UPLIT BYTE(STR_DEF_WORKFILE), 
3; 2195 P : DNS = ZCHARCOUNT(STR_DEF _WORKFILE), 
; 138 i id TUN_K_WRK_PREALL 
3; 2198 U 2241 ALQ = 2 * .CTXCS_WRK_DEQ) ' Tree size 
3 1%? . ri} ef / .CTXCCOM_WRK_FILESJ, ! Divided by number of files 
; 2201 P 2244 DEQ = .CTXCS_WRK_DEQ), ' Default extension quantity 
3 4 P 2245 ' BKS = 8 ! Only for relative or indexed files 
; 220 P 46 ! BLS = ! Only for magnetic tape files 
3 2204 P 224 FAC = <B10,DEL,GET.PUT,UPD> 
: 05 P 2248 FOP = <CBT,DFW.DLT.SUP, TMD, TMP,SQ0,UFO>, ! TMD, TMP??? 
$509 p $556 han = 0° 
D4 = 
: 2208 P 2251 MRS = COM_K_BPERBLOCK, 
; 09 P 2¢ ORG = SEQ, 
3 10 P 225 ! RAT = 0 ' No special record attributes 
3 11 P 2254 RFM = Fix, ' Fixed format records 
: ig P 2255 RTV = 1 ! 10 retrieval pointers 
> 221 P 36 SHR = GET i Allow others to read this file 
> 2214 5 XAB = XABPROCBASE_}); | File protection XAB 
> 2215 P 2258 SNAM_INIT( | 
$ 1 P 2259 RAM = NAMCBASE J 
> 221 P 2260 ESS = NAMSC_MARRSSLCL, | 
: 2218 P 2261 ESA = FNACOJ, 
3 2219 Pp 6¢ RSS = Manse MAXRSSLCL, | 
: 0 6 RSA = FNACO]); 
3 $$ | 
; : $8 WFB_PTR = yiit WRK_WFB); 
3 2226 6 WHICE .WFB PTRCO) NEQ 0 60 WFB_PTR = BBLOCKC.WFB_PTRCO),WFB_NEXT); 
3 5 $8 DECR I] FROM .CTXCCOM_WRK_FILESJ-1 TO 0 DO 
; $ 8 BEGIN 
H 0 STRUCTURE 
; 3 a , BVECTORCI;N,EXT=0) = CN] (BVECTOR+1)<0,8,EXT>; 
: 7 ' Allocate WEB and Link into List (advance to next file at end of loop) 
; 1 74 ! These are put at the end of the List so that SORTWORKO is used first, | 
3 § Le followed by SORTWORK1, et cetera. | 
; 7 WFB = SORSSALLOCATE(WFB_K_SIZE); 
; 5 ’ WFB_PTRCO) = WFBCWFB_NERTI; ! Store address of the next pointer 
; 0 : Get the name of this file 


7 
| 
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39 g IF NOT NULLPARAMETER(1) 
40 THEN 
4) 4 BEGIN 
rk 3 tht FABSB_FN MINU(.FNSCOJ, ZALLOCATION(FNA))) | 
= o o go 
ab ; ener Ae Bat S3); 
46 M4 cLIF -1 GEQU .BVECTORCCTXCCOM_WF_NAMES], 0) | 
48 91 BEGIN 
4 3 FABLFABSB_FNS] = ZCHARCOUNT(STR_LOG_WORKF ILE) +1; 
20 9 CHSMOVE ( 
1 94 ZCHARCOUNT(STR_LOG_WORKFILE), 
2¢ 99 UPL IT BYTE(STRILOG_WORKFILE), | 
54 33 ASSERT (ZCHARCOUNT(STR_LOG WORKNUM) GEQ MAX_WORK_FILES) | 
55 98 CRARCOUNT(STR_LOG-WORRFILE)] = .BVECTORCUPLIT BYTE 
28 9 —- XACTSTRING(MAX_WORK_FILES,O,STR_LOG_WORKNUM)), .1]; ; 
58 01 ELSE | : 
59 308 tir NOT HOSTILE X%THEN | : 
04 LIBRARY "SRC$:SRTSPC’; : 
05 LOCA F 
06 CFT: REF CFT_TABL1); ; 
0 CFT = CFT tap .CTXCCOM_CFT_ADRI, : 
08 -BVECTORCCTXCCOM_WF_NARES], .1+1], BASE_J; : 
0 CHSMOVE ( 


CEABEFABSB_FNS : MINUC CF TCO CFT_CON_LENJ, SALLOCATION(FNA))), 
.CFTCO,CFT—~CON_ADRJ+.CTXCCOM_CFT_ADRJ, FNACOJ); 


ZELSE 
RETURN SORSS$FATAL (SOR$_SHR_BADLOGIC); 


: Clear these fields, since we are reusing the NAM, FAB and XAB blocks 
NAM nanse-FSt1 = 0; 
NAMLNAMSB _ = 0; 
FABCFABSW_IFIJ = 0; 
$XABPRO_IRIT( 

XAB = XABPROCBASE_]), 

PRO = <D,RWED>); 
Actually create the work file 


STATUS = SCREATE(FAB = FABLBASE_] | 
ZIF HOSTILE_ELAN ZTHEN , ELAN = .CTXCCOM_CTXADRI XFI ); | 


Get the best file name string available into NAMS$B_RSL/NAMSL_RSA 
SORSSBEST_FILE_NAME(FABCBASE_], WFBCWFB_NAME)); 

Check status 

If NOT .FABCFABSL_STS) 

THEN 
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3 
SORSSCR_10 16-Sep-1984 00:40:35 AX-11 Bliss-32 V4.0-7 
vOe=000 ¥ 1$-se0-198 98 34 SORTS2. Te SORSCRIO. 839; :1 


RDBCRBB ' Reference the WB 
RDBCRDB_VBN “E 4g ' First virtual block number 
RDB_ -SI7E) = =1; i A 


I . 
<p OrBy eure NOU USE, e* 5. RDB_NEXT); 


RDB very large hole 
END; 


39 BEGIN 
40 SORSTERROR (Sone SHR_OPENOUT AND NOT STSSM_S BErAGSL. OR_STSSK_ERROR, 
re END 1, WEBCWFB _RAMET, -FABCFABSL_STSJ, -FABLFAB STVJ); 
‘8 ELIF NOT .BBLOCKCFABCFABSL_DEV], DEVSV_RND] OR .NAMCNAMSV_NODE3 
re BEGIN 
cf Device must be local and random access. 
P rk SDASSGNC CHAN, Sates STV] 
29 FH te ELAN Bynen o ae N = .CTXCCOM_CTXADR] FI ); 
os 23 SORSSERROR SOR “WORK DEV, FBCWFB_NAME J); 
10 2g ELSE 
\} ze BEGIN 
ig 36 i Save the channel number (returned in STV) 
‘3 ¢f Create a large hole describing available space. 
16 59 LOCAL 
17 60 REF my ida ttt 
18 61 WFBCWF J= STVJ; 
19 o¢ RDB = Saas Locke tos K SIZE); 
20 6 
s 
4 
5 


rorrr 
no 


Check for an error 
if .WFBCWFB_CHAN) EQL 0 
THE 
BEGIN 
Deallocate and unlink 
SOnSSFREE FILE pent ureters -NAME]); ! Free name string 
embH wFB_PTRTO) WEBNEXT, WFB_K $126); 
cr COM” URR FILES) = ree XECOM” WRK_FILESJ - 1; 
ELSE 
BEGIN 
IF — NULLPARAMETER(1) 
SORSSERROR (S085 USE_A 


ZASCIC™ eek), WFBCWFB_NAME)); 
we PTR = ‘ule ire *NEXTA: ' Advance to next WFB 
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ARUN —S Soe LEARAUNISBRLF S 


SSeete sete 
ww 

Go CoCo COCO 
Fwn—0o0 
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END; 
we didn't get enough work files, abort. 


f 
NOT NULLPARAMETER(1) THEN RETURN 
.CTXCCOM_WRK_FILES) LSS MIN_ WORK: “FILES 


WWW AAA AANA 
NNNNOAAO 
—OOe 
ee ee ee tr ee Pl tt tt tt a ot ot ot ot a ot a ot ot 


ww 


Kk 3 
SORSSCR_10 16-Sep-1984 00:40:3 AX-11 Bliss-32 -7% 
v04- 12-08-1382 90:48:28 SORT32.SRCJSOR str ese 
3 
YS_DISK: VECTORC2]_INITIAL( 
“¥CHARCOUNT ('SYSSDISK:') 
UPLIT BYTE('SYS$DISK:')5; 


Try using SYSSDISK for the work files 


CTXCCOM_WRK_FILES] = MIN WORK FILES; 
ASSERT_TMIN— wy FILES EG. 

WORK_OPEN(SYS 

IF .CTXCCOM_ ork tts) LSS MIN_WORK_FILES 


HEN 
p RETURN. SORSSFATAL (SORS_NO_WRK) ; 


' CTXCS_BUF_SIZE] is the number of bytes to use for each buffer. 
It may have been calculated earlier, but that calculation may have been 
' too small. We need at least enough room for a record (rounded up to a 
full number of pages) plus an extra page. 


ASSERT _ (COM_K_BPERPAGE EQL COM K BPERBLOCK) 
ASSERTS ajnuN UN 2EY = RAK GEQ 2*COM_R_BPERPAGE) 


cTxCs 
END; 
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TON 68 
CR ah int intd. + COM_K_BPERPAGE, 
S_BUF itiee : FOUND (.CTXCS_BUF_SIZE], COM_K_BPERPAGE); 
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| ele eked ek ek ek kdl lel ele le el ee tala ee te ee ee ae ee 
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A=POIPPINIPININYINININININIPININUI NI WINN 
CoP “ 
aa 
Zz 
m -@ 
om 
oo 
>e 
“vrs 


52 4F 53 3A 48 43 54 1 52 43 53 24 53 59 53 90990 P.AAA: ASCII \SYSSSCRATCH:SORTWORK.TMP\ 
4B 52 4F 7 54 32 AF 33 80985 P.AAB: .ASCII \SORTWORK\ 
39 38 37 36 35 34 33 31 30 90980 P.AAC: “ASCII \0123456789\ 
00 99 00 68 72 6F 77 O4 OQO9CB P.AAD: .ASCII C42 \work\<0><0><0> 
3A 4B 53 49 44 24 53 59 53 00900 P.AAE: ASCII \SYSS$DISK: 
-EXTRN SYSSCREATE, SYSSDASSGN 
O7FC 06000 WORK_OPEN: 
. WORD e R2,R3,R4,R5,R6,R7,RB,RI_R10 
5A 000000006 00 9€ 9002 MOVAB SOngse SSERAOR ri0 
£ FDFO CE 9€ 00 MOVAB 53g8s 
50 00C4 C8 F6 «BF S78 000 ASHL FObCeTX) . RO 
D 1 CMPL RO. #50 
1 BGEQU \$ 
50 D 1A VL —s #50, R0 
0oOpc «CB p 1D 1$: MOVL RO, 220(CTX) 
0OEO (B OF PUSHAB 224(CTX) 
000000006 99 1 FB CALLS #1, LIBSGET_EF 
0 OD D MOVL RO, STATUS 


3357 
3526 


7) 
o 


Be Oe Oe Oe Oe Se Oe Oe Oe Be Be Be Se Se Se SH Se Se Se Se Se SESH SH Se SHS Se Oe we Oe Se Se Se Oe SH Se Se Se Se Se Se Se Se Se Se Se Se Se Se Se FH Se Se ee Se ae 


3 
SORSSCR_10 18-52 -1984 00:40:3 AX-11 Bliss-32 V4.0-74 Page 70 
y042000 1enee=1bRe SSi78:28 «FMR TL Pb isgc3e ve On 2es 9¢ 27) 
OE 9 £8 BLBS STATUS, 2$ : 337 
9 bp PUSHL STATUS + 2229 
001¢11B4 i DD PUSHL #1839540 : 
6A 3 FB 3 CALLS #3, SORSSERROR : 
0050 = 8F 00 6E 00 $e 4} 2s: MOVCS #0, (SP), #0, #80, SRMS_PTR : “ 
BO A 6 F B 4A MOVW #20483, SRMS_PTR : 
B4 AD 002280 C ef DO 00 0 MOVL 3 61116, SRAS_PTR+4 : | 
C4 AD 00D¢ CB g 0 MOVW  220(CTX). $RMS~PTR+20 : 
C6 AD F MOVB #47, $RMS_PTR+ : 
CC AD A 8 6 MOVW #10, S$RMS"PTR+ : 
CF AD 01 90 000 MOVB #1, SRMS_PTR+31 : 
D4 = AD 98 AE 9E 0006A MOVAB XABPRO, SRMS_PTR+36 : 
D8 AD FF50 CD 9E O006F MOVAB NAM, SRMS_PTR+40 : 
DC AD 60 AE 9€E 00075 MOVAB NA, $RMS"PTR+44 : 
EO AD FF46 OCF 3 007A MOVAB RAS PTR+48 : 
£5 AD 18 9 90080 MOVB He $rms_PTR+53 : 
£6 AD 0200 8F 80 0084 MOVW #512, SRMS_PTR+54 : 
0060 8F 00 6E ed 00 C o0034 movcS #0, (SP), #O, #96, SRMS_PTR + 2263 
FFSO 3=— CD 6002 8F BO 00094 MOVW #24578, SRMS_PTR : 
FFS52 86CD 01 8E 00098 MNEGB #1, SRMS_PTRF2 : 
FF54 «CD 60 AE 9E O00A0 MOVAB NA, $RMS_PTR+4 : 
FFSA CD 01 BE 0006 MNEGB #1, SRMS_PTR+10 ; 
FFSC §=CD 60 AE 9%E OO00AB MOVAB = FNA, $RMS_PTR+12 3 
58 00E4 CB 9E 00081 MOVAB 228(R11), WFB_PTR : 2266 
68 b3 00086 3$: TSTL (WFB_PTRS + 2267 
05 13 00088 BEQL 6 4$ ; 
58 68 DO OOOBA MOVL (WFB_PTR), WFB_PTR : 
F7 11 000BD BRB 3$ : 
57 SA AB 9A OOOBF 4$ MOVZBL 90(CTX), I > 2268 
014€ 31 000C3 BRw les F 
0 DD 00066 5s PUSHL #32 : 2277 
000000006 00 1 FB 000C8 CALLS #1, SORSSALLOCATE ; 
56 0 dO O00CF MOVL RO, WFB ; 
fA 56 D0 000D MOVL WFB, (WFB_PTR) : 2278 
6c 95 000D TSTB —s_ CAPS > 2282 
25 13 0000 BEQL 486 7$ : 
04 AC : 0009 TSTL  4CAP) F 
20 000€ BEQL «6s 7$ ; 
50 04 AC 00 0000 MOVL FNS, RO : 2286 
31 $9 D0 0 E MOVL (ROS, R1 ; 
Qo00OOFF BF 1D E CMPL =e R1, #255 : 
4 18 6 EC BLEQU 6$ : 
51 FF F 9A OO0E MOVZBL #255 R1 ; 
Fs AD 1 30 Fo 6$: MOVB. RI, FAB+5S2 : 
60 AE 4 8B 1 é F MOVC3 R1, a4(RO), FNA > 2287 
f 1 OO00FC BRB 3 : 228 
57 0134 CB 08 FD FE 7$ CMPZV #0, #8, 308(CTX), I > 228 
4 1a 001 BGTRU 8s ; 
E4 AD 9 90 001 MOVB) #9, FAB+S2 : 2292 
60 AE FECC OCF 8 é 1 MOVC3 #8. P.AAB, FNA > 2296 
68 AE FECD CF 1 MOVE P.AACEIJ, FNA+8 + 2298 
21. 11 «0011 BRB 3 : 2288 
50 0135 (B47 9A 0011B 8S MOVZBL 309(CTX)CIJ, RO : 2308 


m 3 
SORSSCR_10 16-Sep-1984 00:40:3 AX-11_ Bliss-32 V4.0-74 Page 71 S 
y0e2006 12-80 8= 1382 90:48:28 SORT32.SRC SORSC R10.8 63351 9° 29) V 
06 C4 00121 MULL2 #6, RO ; ; 
30 010¢ cB 0 00124 RLS 268(CTX), CFT : : 
1 § A 00129 MOVZBL (CFT) Ri + 2310 : 
F4 AD 1 90 001 MOVE R1, FAB+52 : ; 
50 2 Ad 010¢ cB 1 001 ADDL 3 268(CTX), 2(CFT), RO : 2311 ; 
60 AE 6 8 001 MovCS RI, {R0), FNA : ; 
FF53. CD «(94 «(001 f 9$ CLRB Ss NAM+ + 2319 F 
FF5B «CD (94 0014 CLRB Ss NAM#11 : 2320 ; 
B2 AD B4 144 CLRW FAB+e + 2321 ; 
0058 8F 00 6E : 00 C O47 MOVCS #0, (SP), #0, #88, SRMS_PTR + 23246 : 
08 AE sais oF 80 0150 MOVW #22547, $RMS_PTR : : 
10 AE FFO F BO 00156 OVW #-249, SRMS_PTR+8 : : 
BO AD 9F 0015¢ PUSHAB FA + 2329 : 
000000006 00 01 FB 0015 CALLS #1, SYSSCREATE : ; 
59 50 00 0166 MOVL RO. STATUS ; : 
52 04 As 9E 0016 MOVAB 4(WFB), R + 2333 ; 
52 DD 0016D PUSHL R2 : ; 
BO AD OF O016F PUSHAB FAB : ; 
000000006 00 02 FB 00178 CALLS #2 SORSSBEST _FILE_NAME : ; 
13 B8 AD EB 0017 BLBS FAB+B, 10$ : 2337 ; 
B8 AD 7D 0017D OVO FAB+B, -(SP) + 2341 : 
52 DD 00181 PUSHL R2 : ; 
01 DD 00183 PUSHL #1 : : 
001C10A2 BF DD 00185 PUSHL #1839266 : F 
6A 05 FB 00188 CALLS #5, SORSSERROR : : 
45 11 00185 BRB 13§ : 2337 : 
05 F3) AD 04 £1 00190 10$: BC #4, FAB+67, 11$ : 2343 3 
19 86 AD 01 €1 00195 BBC #1. NAM+54, 12$ : : 
BC AD DD 0019A 11$:  PUSHL FAB+12 + 2350 : 
000000006 00 01 FB 0019D CALLS #1, SYSSDASSGN : ; 
52 DD O01A4 PUSHL R2- : 238i F 
01 DD 001A6 PUSHL : ; 
001C800A 8F DD 001A8 PUSHL #1867786 : : 
6A 03 FB OO1AE CALLS #3, SORSSERROR 3 3 
22 11 00181 BRB + 2342 ; 
1E 6 BC AD 8000183 12$:  MOVW FAB+12, 30(WFB) : 2361 : 
10 OD 00188 PUSHL > 2362 ; 
000000006 00 01 FB 01BA CALLS SORSSALLOCATE : : 
60 14 A6 DO 001C1 MOVL SOtws (RDB) : 2363 : 
14 Ab 0 DdO 001C5 MOVL _—— RDB, ee otures : ; 
04 AO 6 DO 001C9 MOVL WFB, 4(RDB) + 2364 ; 
08 a0 1 00 001CD MOVL #1, 8(RDB) + 2365 ; 
0c AO 01 CE 00101 MNEGL #1. 12(RDB) : 396 : 
1E Ab 8 105 13$ TSTw  30¢WFB) : 2 : 
18 108 BNEQ 14$ : : 
F DD OO1DA PUSHL Re 3 2378 3 
000000006 00 1 FB 001D CALLS #1, SORSSFREE_FILE_NAME : : 
DD OO1E PUSHL  (WFB) : 2379 ; 
DD OO1E PUSHL Ur BTR : : 
DD OOTE PUSHL : ; 
000000006 00 Fe 1€9 CALLS SORSSDEALLOCATE ; : 
5A AB 97 OOTF DECB S0tct : 2380 : 
1D 11 OO1F BRB 16$ : 2372 ; 
6C 95 001F5 148:  TSTB (AP) > 2384 3 
16 1 1F BEQL 15$ : : 
04 AC 05 001F9 TSTL  4(AP) ; ; 
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644 bytes, 


; Routine Size: 


pu19b4 13:10:49 LSGaTs2eSneSsORseRiO.650: 1 F098 ob} 


SORSSCR_10 
v04-000 


ROUTINE VALUE: 


8¢ GLOBAL ROUTINE SOR$SWRK_ALQ: CAL_CTXREG = 
88 14 
89 i 
90 i FUNCTIONAL DESCRIPTION: 
3 Calculate work file allocation. 
34 ; FORMAL PARAMETERS: 
96 i NONE 
97 i 
98 i IMPLICIT INPUTS: 
99 i 
90 NONE 
0¢ IMPLICIT OUTPUTS: 
04 i NONE 
05 
! 
i 
f 
; 
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| ek ek le eel el al el el tel el tel el et et ed ed ede 
SND DS DDD DOD TTT BB BBE EE PAW NN 
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; 
2 
3407 
§ oS Total work file allocation. 
2410 SIDE EFFECTS: 
2411 
2 \¢ NONE 
§ 1 
14 os 
2415 BEGIN 
2416 EXTERNAL REGISTER 
2417 CTX = COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); 
2418 LOCAL 
2419 WFB: REF WFB Beck. 
2 3 " WFALQ: INITIALTO); 
$ $§ 4 ' Loop Soroush all the work files 
$252 : computing the total number of blocks allocated to them. | 
425 4 WEB = .CTXCS_WRK_WFB); 
426 4 WHILE WFBCBASE J~NEQ 0 DO 
427 4 FALQ = .QFALQ + .WFBCWFB_ALQ]; WFB = .WFBCWFB_NEXT)); 
428 4 RETURN .WFALQ; 
$$3 4 
4350 4 END; | 


00 00000 -ENTRY SORSSWRK_ALQ, Save nothing ; $38 
D4 000 RL WFALQ ; 

Dd 0 MOVL 28(CTX), WFB 

1 1$: BEQL $ 

4 recur) . WFALQ 
11 1 


WFB), WFB 
$ 


ee ee te Se ee Oe e 
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1 
1 
50 51 00 00014 2$: MOVL WFALQ, RO i 247 
04 80017 RET 3 247 


SORSSCR 10 


; Routine Size: 24 bytes, Routine Base: SORSRO_CODE + O0C5D 


dD 4 
$SCR_10 16-Sep-1984 00:40:3 AX-11 Bliss-32 V4.0-74 Page 75 
yons0007 12-80-1382 90:48:28 {8 arat 2.SRCISORSCRIO.B32; 9° (29) 
; ry § ot? } ROUTINE CLEAN_UP: CAL_CTXREG NOVALUE = : 
: 2434 475 1 t+ ; 
> 2435 476 ii ; 
; 4 6 47 | FUNCTIONAL DESCRIPTION: ; 
; 4 3 ‘79 : } Release resources allocated by this module. : 
2 $270 481 1 | FORMAL PARAMETERS: 
+ 2641 4 ; 1 i ; 
+ 264 483 1! NONE : 
> 044 484 1: ; 
> 2666 485 1.) IMPLICIT INPUTS: : 
+ 2665 4 6 i 3 
sis eae 7 
> 2648 489 1! IMPLICIT OUTPUTS: 
: £30 re | NONE : 
: 2451 492 1! 3 
: Abe 493 1 ' ROUTINE VALUE: ; 
> 245 494 1 : 
3: 2454 495 1! NONE (signals errors) : 
> 2455 496 1! 3 
: 2656 497 1 | SIDE EFFECTS: : 
> 2457 498 1! ; 
: 2458 499 1/3 NONE : 
Bp BRT : 
> 2461 308 BEGIN 
; 46¢ 50 EXTERNAL _REGISTER ; 
; 463 2906 cocate™ COM_REG_CTX: REF CTX_BLOCK_(S_FIELDS); : 
; 2665 306 WFB: REF WFB BLOCK, ; 
; 466 50 WEB_ADR:REF VECTOR(1), : 
: eee 358 ware 
3 2469 510 3 
3 rth 3) Cancel the post-checkpoint handler : 
> 247 U 318 Z1F FUNK CHECKPOINT XTHEN ; 
+ 247 U 2514 IF CHKSCARPSH 0 THEN ; 
3 rt ¥ 316 ra s "PSH HANDLERS NEQ 0 : 
3 267 1 BEGIN : 
: t39 y 318 STATUS | = CHKSCANPSH(CTXCS_PSH_HANDLER)); ; 
> 2478 U 251 IF :STATUS AND .CTXCS RSHHANDLER] NEQ 6 THEN ; 
: 2479 U 2520 STATUS = CHKSCANRSH(CTXES-RSH HANDLER) ; | 
; iat U ; 1 IF NOT . STATUS | : 
t 26 i y 3 § SORSSERROR (SORE. SHR_SYSERROR AND NOT STSSM_SEVERITY OR STSS$K_WARNING, | : 
4 U e = . 
: 26 U 2525 END; | : 
| o 
3 26 3 ! Deallocate the work file event flag : 
a 488 5 ! ° 
| 


4 
SORSSCR_10 1-se 1984 00:40:3 AX=11 Bliss-32 V4.0-74 
vou 12-8 08-1 obec 90:98:28 feoRT 2.SRCJSORSCRIO.B32;1 
; 2489 0 ZIF NOT HOSTILE ey 
; 2490 1 . -CTXCS_WRK_EFN] NEQ 0 
: 2491 § HEN 
; 249 BEGIN 
: 249 4 A 
> 2494 5 STATUS; 
> 2695 § STATUS = LIBSFREE EF (CTxts WRK_EFN); 
3 re IF NOT .STATUS THEN SORSSERRORT 
; 249 3 7 SHR_SYSERROR AND NOT STSSM_SEVERITY OR STSSK_ERROR, 
3 res . «STATOS); 
3 246 40 END; 
3 280 4) 2FI 
; 2501 rs 
; 286 54 
3 a3? 239 Deallocate the run description blocks from the active List. 
; 2505 ete BEGIN 
; 2506 547 LOCAL 
; 2507 548 REF VECTOR(1), 
; 2508 549 RUN REF RUN_BLOCK; 
3: 2509 550 Q = CTXCS_RUN_INFOJ; 
; 2510 551 WHILE (RUN = 7QCOJ) NEQ 0 DO DELRUN(RUN[BASE_)); 
: 2511 23 END; 
3 alg 55 
3; 251 554 
3 2514 555 ' For each WEB Linked into this List 
3: 2515 556 ! 
3 2516 557 WFB_ADR = CTXCS_WRK Hath 
; 317 558 WHICE (WEB = .WFB_ABRCOJ) NEQ 0 DO 
: 2518 559 BEGIN 
3; 2519 560 
; 2520 561 ! Deassign the channel 
3 $2s) $206 ' 
: 25 ; 56 IF .WFBCWFB_CHAN] NEQ 0 
3: 252 2564 THEN 
3 2524 2565 4 N 
; 2525 b $208 4 STATUS = SDASSGN(CHAN=.WFBCWFB CHAN] 
: 2526 567 4 STILE_ELAN ZTHEN , ECAN = -CTXCCOM_CTXADR] ZFI ); 
: sest 2568 4 IF NOT .STATUS THEN SOR R 
3 2528 2569 4 SHR_SYSERROR AND NOT STSSM_SEVERITY OR STSSK_ERROR, 
3 44 570 4 -STATOS); 
3 2530 571 4 WFBCWRB_CHAN) = 0; 
3: 2531 276 END; 
: 25 $ 57 
: 2 af Free the file name string 
; 2535 278 SORSSFREE_F ILE_NAME (WFBCWFB_NAME)); ! Free name string 
3 : 578 ' Free the RDBs Linked to this WB 
3 238 T4 ! 
3; 2539 0 4 BEGIN 
3; 2540 581 4 LOCAL 
3: 2541 5 ; 4 Q: REF VECTORC1), 
s 246 5 4 RDB: REF RDB_BLOCK; 
3 254 584 4 Q = WFBCWFB_FRE ij 
; 344 585 4 WHILE (RDB = .0 ) NEQ 0 DO REMLH_(Q(0J, RDB, RDB_NEXT, RDB_K_SIZE); 
: 2545 5 4 Q = WFBCWFB_NOUSE); 


<yv 


F 4 
stain" NECSEBISR USAGES WASALOLESSRStABE8B,1 oH 


4 WHILE (RDB = .QC0J) NEQ 0 DO REMLH_(QC0J, RDB, RDB_NEXT, RDB_K_SIZE); 
Q= WFBLWEB FULL : 
WHILE (RDB = .QC05) NEQ 0 DO REMLH_(OC0], RDB, RDB_NEXT, RDB_K_SIZE); 


Free the WFB 
REMLH_(WFB_ADRCOJ, WEB, WEB_NEXT, WFB_K_SIZE); 
END; 


Deallocate the buffers 
BEGIN 


LOCAL 
Q: REF VECTORC1), 
BUF: | REF BUF_BLOCK, 
: REF BUF “BLOCK: 
Q = CTXCS_BUF ayLocy: 
WHILE (P = .Qf0)) NEQ 0 DO 
BEGIN 


BUF = .PCBUF_ADDR]; 

BUF CBUF_NEXT] = .PLBUF_NEXT); 

BUF BUF~ADDR] = .PCBUF~ADDR): 

ato) = BUF CBASE j; 

RENLH. (Q OJ, BUF, BUF_NEXT, .CTXCS_BUF_SIZE]+COM_K_BPERPAGE); 


END; 
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END; 


1FC 00000 CLEAN_UP: 
O1FC COSC CLEANUP R3.R4,R5,RO,R7-RE 


WORD Save R2 3 
58 000000006 00 9€ 9902 MOVAB SORSSERRO : 
57 000000006 00 9E 000 MOVAB ; RSSDEALLOCATE, R7 F 
00EO CB OD 9 10 TSTL 4(CTX) > 2531 
iB 1 14 BEQL si : 
00E0 8 9F 0 16 PUSHAB 224(CTX) : 2536 
000000006 00 re 1A CALLS #1, LIBSFREE_EF : 
0D 6 E8 00021 BLBS § STATUS, 1$ > 2537 
DD 9 4 PUSHL STATUS : 2539 
—E D4 6 LRL = (sh) > 2537 
eset Bi Ct He seanon = 
0008 cB 9 ; 1$: V BibT) Q : 3550 
D 23: VL Q), RUN : 51 
1 BEQL 3$ 3 
DD B PUSHL RUN ; 
FCBA CF I FB ; CALLS #1, DELRUN : 
55 Q0ES CB 9E 00044 35: MOVAB sacRI1). WFB_ADR : 2557 
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MAT PAWN FD FF HWOVMIOWOW 


oO 
MONS SSR UO S ORO RE Bo 


:3 AX-11 Bliss-32 


74 SORT32.SRCJSOR sth 


(WFB_ADR), WFB 


~—— £ 


, RbB 


on AVS BO- eo BF was 


#16 
#3, SORSSDEALLOCATE 


24(R2), Q 
(Q), ROB 
12$ 


(RDB) 
Q 
#16 
#36 SORSSDEALLOCATE 
ne 
ADR 
ae SORSSDEALLOCATE 


we’ iets 
), 


#512 208(¢ x) 
A} Sor$$D a écate 
14$ 
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: PSECT SUMMARY 

: Name Bytes Attributes 

; SORSRO_CODE. IS NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC.ALIGN(2) 
; SORSRO_ CODE 3426 NOVEC, *NOWRT. RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 
3 Library Statistics 

ite ap te rt ed = Symbols -------- Pages Processing 

3 File Total Loaded Percent Mapped Time 

: $2 55$0UA28: (SYSLIB STARLET T 6323 1 9776 131 1 581 00:01.0 

; “35 55$DUA 28: Son} 590 $3 4 252 00:00.6 

; =$2 33SDUA nee: SOnTSe ERC ate Mere 1 409 150 36 34 00:00.4 

; “$5 5SS$DUA28: Sone Re SRTSPC.L32:1 120 3 2 12 00:00.1 

: COMMAND QUALIFIERS 

: BLISS/CHECK=(FIELD, INITIAL,OPTIMIZE) /NOTRACE/LIS=LIS$:SORSCRIO/OBJ=OBJ$:SORSCRIO MSRC$:SORSCRIO/UPDATE=(ENHS: SORSCRIO) 


: Size: 3366 ¢ + 64 data bytes 
; Run Time: OL: 8 

; Elapsed Time 

3 Lines/CPU Rin: 

3 ponenees Awe! 42h 

; Memory Used: 94 pages 
; Compication “Complete 
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